home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / dbclient.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  75.3 KB  |  2,683 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Client DataSet                                  }
  6. {                                                       }
  7. {       Copyright (c) 1997 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DBClient;
  12.  
  13. {$R-}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Graphics, Classes, Controls, Forms, Db,
  18.   BDE, DSIntf, DBCommon, StdVcl;
  19.  
  20. type
  21.  
  22. { Exceptions }
  23.  
  24.   EDBClient = class(EDatabaseError)
  25.     FErrorCode: DBIResult;
  26.   public
  27.     constructor Create(Message: string; ErrorCode: DBIResult);
  28.     property ErrorCode: DBIResult read FErrorCode;
  29.   end;
  30.  
  31.   EReconcileError = class(EDatabaseError)
  32.     FContext: string;
  33.   public
  34.     constructor Create(NativeError, Context: string; ErrorCode: DBIResult);
  35.     property Context: string read FContext;
  36.   end;
  37.  
  38. { TRemoteServer }
  39.  
  40.   TClientDataSet = class;
  41.  
  42.   TCustomRemoteServer = class(TComponent)
  43.   protected
  44.     procedure AddDataSet(DataSet: TClientDataSet); virtual;
  45.     procedure RemoveDataSet(DataSet: TClientDataSet); virtual;
  46.     function GetConnected: Boolean; virtual;
  47.     function GetProvider(const ProviderName: string): IProvider; virtual; abstract;
  48.     procedure SetConnected(Value: Boolean); virtual; abstract;
  49.     property Connected: Boolean read GetConnected write SetConnected default False;
  50.   end;
  51.  
  52.   TRemoteServer = class(TCustomRemoteServer)
  53.   private
  54.     FComputerName: string;
  55.     FServerName: string;
  56.     FDataSets: TList;
  57.     FDispatch: IDispatch;
  58.     FStreamedConnected: Boolean;
  59.     FOnConnect: TNotifyEvent;
  60.     FOnDisconnect: TNotifyEvent;
  61.     procedure SetComputerName(const Value: string);
  62.     procedure SetServerName(const Value: string);
  63.   protected
  64.     procedure AddDataSet(DataSet: TClientDataSet); override;
  65.     function GetConnected: Boolean; override;
  66.     procedure Loaded; override;
  67.     procedure SetConnected(Value: Boolean); override;
  68.     procedure RemoveDataSet(DataSet: TClientDataSet); override;
  69.   public
  70.     constructor Create(AOwner: TComponent); override;
  71.     destructor Destroy; override;
  72.     function GetProvider(const ProviderName: string): IProvider; override;
  73.     property ServerDispatch: IDispatch read FDispatch;
  74.   published
  75.     property ComputerName: string read FComputerName write SetComputerName;
  76.     property Connected;
  77.     property ServerName: string read FServerName write SetServerName;
  78.     property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
  79.     property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
  80.   end;
  81.  
  82. { TClientDataSet }
  83.  
  84.   PFieldDescList = ^TFieldDescList;
  85.   TFieldDescList = array[0..1023] of DSFLDDesc;
  86.  
  87.   TKeyIndex = (kiLookup, kiRangeStart, kiRangeEnd, kiCurRangeStart,
  88.     kiCurRangeEnd, kiSave);
  89.  
  90.   PRecInfo = ^TRecInfo;
  91.   TRecInfo = packed record
  92.     RecordNumber: Longint;
  93.     BookmarkFlag: TBookmarkFlag;
  94.     Attribute: DSAttr;
  95.   end;
  96.  
  97.   PKeyBuffer = ^TKeyBuffer;
  98.   TKeyBuffer = record
  99.     Modified: Boolean;
  100.     Exclusive: Boolean;
  101.     FieldCount: Integer;
  102.     Data: record end;
  103.   end;
  104.  
  105.   TReconcileAction = (raSkip, raAbort, raMerge, raCorrect, raCancel, raRefresh);
  106.   TReconcileErrorEvent = procedure(DataSet: TClientDataSet; E: EReconcileError;
  107.     UpdateKind: TUpdateKind; var Action: TReconcileAction) of object;
  108.  
  109.   TClientDataSet = class(TDataSet)
  110.   private
  111.     FDSBase: IDSBase;
  112.     FDSCursor: IDSCursor;
  113.     FLookupCursor: IDSCursor;
  114.     FFindCursor: IDSCursor;
  115.     FCloneSource: TClientDataSet;
  116.     FData: OleVariant;
  117.     FDelta: OleVariant;
  118.     FIndexDefs: TIndexDefs;
  119.     FIndexName: string;
  120.     FExprFilter: HDSFilter;
  121.     FFuncFilter: HDSFilter;
  122.     FFilterBuffer: PChar;
  123.     FMasterLink: TMasterDataLink;
  124.     FIndexFieldMap: DSKEY;
  125.     FKeyBuffers: array[TKeyIndex] of PKeyBuffer;
  126.     FKeyBuffer: PKeyBuffer;
  127.     FNewValueBuffer: PChar;
  128.     FOldValueBuffer: PChar;
  129.     FCurValueBuffer: PChar;
  130.     FIndexFieldCount: Integer;
  131.     FProvider: IProvider;
  132.     FProviderName: string;
  133.     FRemoteServer: TCustomRemoteServer;
  134.     FPacketRecords: Integer;
  135.     FConstDisableCount: Integer;
  136.     FKeySize: Word;
  137.     FRecordSize: Word;
  138.     FBookmarkOfs: Word;
  139.     FRecInfoOfs: Word;
  140.     FRecBufSize: Word;
  141.     FReadOnly: Boolean;
  142.     FFieldsIndex: Boolean;
  143.     FCanModify: Boolean;
  144.     FInReconcileCallback: Boolean;
  145.     FNotifyCallback: Boolean;
  146.     FProviderEOF: Boolean;
  147.     FFetchOnDemand: Boolean;
  148.     FOnReconcileError: TReconcileErrorEvent;
  149.     procedure AddExprFilter(const Expr: string; Options: TFilterOptions);
  150.     procedure AddFuncFilter;
  151.     function CalcFieldsCallBack(RecBuf: PChar): DBIResult; stdcall;
  152.     procedure CheckMasterRange;
  153.     procedure CheckProviderEOF;
  154.     function CreateDSBase: IDSBase;
  155.     function CreateDSCursor(SourceCursor: IDSCursor): IDSCursor;
  156.     procedure DecodeIndexDesc(const IndexDesc: DSIDXDesc;
  157.       var Name, Fields: string; var Options: TIndexOptions);
  158.     procedure EncodeFieldDesc(var FieldDesc: DSFLDDesc; const Name: string;
  159.       DataType: TFieldType; Size: Word; Calculated: Boolean);
  160.     procedure EncodeIndexDesc(var IndexDesc: DSIDXDesc;
  161.       const Name, Fields: string; Options: TIndexOptions);
  162.     procedure FetchMoreData(All: Boolean);
  163.     function FilterCallback(RecBuf: PChar): Bool; stdcall;
  164.     function GetActiveRecBuf(var RecBuf: PChar): Boolean;
  165.     function GetChangeCount: Integer;
  166.     function GetData: OleVariant;
  167.     function GetDelta: OleVariant;
  168.     function GetIndexDefs: TIndexDefs;
  169.     function GetIndexFieldNames: string;
  170.     function GetIndexName: string;
  171.     function GetLogChanges: Boolean;
  172.     function GetMasterFields: string;
  173.     function GetProvider: IProvider;
  174.     procedure InitBufferPointers(GetProps: Boolean);
  175.     procedure MasterChanged(Sender: TObject);
  176.     procedure MasterDisabled(Sender: TObject);
  177.     procedure NotifyCallback; stdcall;
  178.     procedure ReadData(Stream: TStream);
  179.     function ReconcileCallback(iRslt: Integer; iUpdateKind: DSAttr;
  180.       iResAction: dsCBRType; iErrCode: Integer; pErrMessage, pErrContext: PChar;
  181.       pRecUpd, pRecOrg, pRecConflict: Pointer): dsCBRType; stdcall;
  182.     procedure SetData(Value: OleVariant);
  183.     procedure SetDataSource(Value: TDataSource);
  184.     procedure SetIndex(const Value: string; FieldsIndex: Boolean);
  185.     procedure SetIndexFieldNames(const Value: string);
  186.     procedure SetIndexName(const Value: string);
  187.     procedure SetLogChanges(Value: Boolean);
  188.     procedure SetMasterFields(const Value: string);
  189.     procedure SetNotifyCallback;
  190.     procedure SetProvider(Value: IProvider);
  191.     procedure SetProviderName(const Value: string);
  192.     procedure SetRemoteServer(Value: TCustomRemoteServer);
  193.     procedure SortOnFields(Cursor: IDSCursor; const Fields: string;
  194.       CaseInsensitive, Descending: Boolean);
  195.     procedure SetupInternalCalcFields;
  196.     procedure WriteData(Stream: TStream);
  197.   protected
  198.     procedure ActivateFilters;
  199.     procedure AddDataPacket(Data: OleVariant; HitEOF: Boolean); virtual;
  200.     procedure AddFieldDesc(FieldDesc: DSFLDDesc; Required: Boolean; FieldNo: Word);
  201.     procedure AllocKeyBuffers;
  202.     function AllocRecordBuffer: PChar; override;
  203.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; override;
  204.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  205.       Decimals: Integer): Boolean; override;
  206.     procedure Cancel; override;
  207.     procedure Check(Status: DBIResult);
  208.     procedure CheckSetKeyMode;
  209.     procedure ClearCalcFields(Buffer: PChar); override;
  210.     procedure CloseCursor; override;
  211.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  212.     procedure DeactivateFilters;
  213.     procedure DefineProperties(Filer: TFiler); override;
  214.     procedure DestroyLookupCursor; virtual;
  215.     procedure DoOnNewRecord; override;
  216.     function FindRecord(Restart, GoForward: Boolean): Boolean; override;
  217.     procedure FreeKeyBuffers;
  218.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  219.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  220.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  221.     function GetCanModify: Boolean; override;
  222.     function GetDataSource: TDataSource; override;
  223.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  224.     function GetIndexField(Index: Integer): TField;
  225.     function GetIndexFieldCount: Integer;
  226.     function GetIsIndexField(Field: TField): Boolean; override;
  227.     function GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  228.     function GetKeyExclusive: Boolean;
  229.     function GetKeyFieldCount: Integer;
  230.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  231.     function GetRecordCount: Integer; override;
  232.     function GetRecNo: Integer; override;
  233.     function GetRecordSize: Word; override;
  234.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;
  235.     function InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  236.     procedure InitRecord(Buffer: PChar); override;
  237.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  238.     procedure InternalClose; override;
  239.     procedure InternalDelete; override;
  240.     procedure InternalFirst; override;
  241.     procedure InternalGotoBookmark(Bookmark: TBookmark); override;
  242.     procedure InternalHandleException; override;
  243.     procedure InternalInitFieldDefs; override;
  244.     procedure InternalInitRecord(Buffer: PChar); override;
  245.     procedure InternalLast; override;
  246.     procedure InternalOpen; override;
  247.     procedure InternalPost; override;
  248.     procedure InternalSetToRecord(Buffer: PChar); override;
  249.     function IsCursorOpen: Boolean; override;
  250.     procedure Loaded; override;
  251.     function LocateRecord(const KeyFields: string; const KeyValues: Variant;
  252.       Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  253.     procedure OpenCursor(InfoQuery: Boolean); override;
  254.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  255.     procedure Post; override;
  256.     procedure PostKeyBuffer(Commit: Boolean);
  257.     procedure RefreshInternalCalcFields(Buffer: PChar); override;
  258.     function ResetCursorRange: Boolean;
  259.     procedure SetAltRecBuffers(Old, New, Cur: PChar);
  260.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  261.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  262.     function SetCursorRange: Boolean;
  263.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  264.     procedure SetFilterData(const Text: string; Options: TFilterOptions);
  265.     procedure SetFiltered(Value: Boolean); override;
  266.     procedure SetFilterOptions(Value: TFilterOptions); override;
  267.     procedure SetFilterText(const Value: string); override;
  268.     procedure SetIndexField(Index: Integer; Value: TField);
  269.     procedure SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  270.     procedure SetKeyExclusive(Value: Boolean);
  271.     procedure SetKeyFieldCount(Value: Integer);
  272.     procedure SetKeyFields(KeyIndex: TKeyIndex; const Values: array of const);
  273.     procedure SetLinkRanges(MasterFields: TList);
  274.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
  275.     procedure SetRecNo(Value: Integer); override;
  276.     procedure SwitchToIndex(const IndexName: string);
  277.     procedure SyncCursors(Cursor1, Cursor2: IDSCursor);
  278.     property DSBase: IDSBase read FDSBase;
  279.     property DSCursor: IDSCursor read FDSCursor;
  280.   public
  281.     constructor Create(AOwner: TComponent); override;
  282.     destructor Destroy; override;
  283.     procedure AddIndex(const Name, Fields: string; Options: TIndexOptions);
  284.     procedure AppendData(Data: OleVariant; HitEOF: Boolean);
  285.     procedure ApplyRange;
  286.     function ApplyUpdates(MaxErrors: Integer): Integer;
  287.     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  288.     procedure CancelRange;
  289.     procedure CancelUpdates;
  290.     procedure CreateDataSet;
  291.     procedure CloneCursor(Source: TClientDataSet; Reset: Boolean);
  292.     procedure ClearChangeLog;
  293.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  294.     procedure DeleteIndex(const Name: string);
  295.     procedure DisableConstraints;
  296.     procedure EnableConstraints;
  297.     procedure EditKey;
  298.     procedure EditRangeEnd;
  299.     procedure EditRangeStart;
  300.     function FindKey(const KeyValues: array of const): Boolean;
  301.     procedure FindNearest(const KeyValues: array of const);
  302.     function GetCurrentRecord(Buffer: PChar): Boolean; override;
  303.     procedure GetIndexInfo;
  304.     procedure GetIndexNames(List: TStrings);
  305.     function GetNextPacket: Integer;
  306.     procedure GotoCurrent(DataSet: TClientDataSet);
  307.     function GotoKey: Boolean;
  308.     procedure GotoNearest;
  309.     function Locate(const KeyFields: string; const KeyValues: Variant;
  310.       Options: TLocateOptions): Boolean; override;
  311.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  312.       const ResultFields: string): Variant; override;
  313.     procedure LoadFromFile(const FileName: string);
  314.     procedure LoadFromStream(Stream: TStream);
  315.     function Reconcile(Results: OleVariant): Boolean;
  316.     procedure RevertRecord;
  317.     procedure SaveToFile(const FileName: string);
  318.     procedure SaveToStream(Stream: TStream);
  319.     procedure SetKey;
  320.     procedure SetRange(const StartValues, EndValues: array of const);
  321.     procedure SetRangeEnd;
  322.     procedure SetRangeStart;
  323.     function UndoLastChange(FollowChange: Boolean): Boolean;
  324.     procedure UpdateIndexDefs; override;
  325.     function UpdateStatus: TUpdateStatus;
  326.     property ChangeCount: Integer read GetChangeCount;
  327.     property Data: OleVariant read GetData write SetData;
  328.     property Delta: OleVariant read GetDelta;
  329.     property IndexDefs: TIndexDefs read GetIndexDefs;
  330.     property IndexFieldCount: Integer read GetIndexFieldCount;
  331.     property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
  332.     property KeyExclusive: Boolean read GetKeyExclusive write SetKeyExclusive;
  333.     property KeyFieldCount: Integer read GetKeyFieldCount write SetKeyFieldCount;
  334.     property KeySize: Word read FKeySize;
  335.     property LogChanges: Boolean read GetLogChanges write SetLogChanges;
  336.     property Provider: IProvider read GetProvider write SetProvider;
  337.   published
  338.     property Active;
  339.     property AutoCalcFields;
  340.     property FetchOnDemand: Boolean read FFetchOnDemand write FFetchOnDemand default True;
  341.     property Filter;
  342.     property Filtered;
  343.     property FilterOptions;
  344.     property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
  345.     property IndexName: string read GetIndexName write SetIndexName;
  346.     property MasterFields: string read GetMasterFields write SetMasterFields;
  347.     property MasterSource: TDataSource read GetDataSource write SetDataSource;
  348.     property PacketRecords: Integer read FPacketRecords write FPacketRecords default -1;
  349.     property ProviderName: string read FProviderName write SetProviderName;
  350.     property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
  351.     property RemoteServer: TCustomRemoteServer read FRemoteServer write SetRemoteServer;
  352.     property BeforeOpen;
  353.     property AfterOpen;
  354.     property BeforeClose;
  355.     property AfterClose;
  356.     property BeforeInsert;
  357.     property AfterInsert;
  358.     property BeforeEdit;
  359.     property AfterEdit;
  360.     property BeforePost;
  361.     property AfterPost;
  362.     property BeforeCancel;
  363.     property AfterCancel;
  364.     property BeforeDelete;
  365.     property AfterDelete;
  366.     property BeforeScroll;
  367.     property AfterScroll;
  368.     property OnCalcFields;
  369.     property OnDeleteError;
  370.     property OnEditError;
  371.     property OnFilterRecord;
  372.     property OnNewRecord;
  373.     property OnPostError;
  374.     property OnReconcileError: TReconcileErrorEvent read FOnReconcileError write FOnReconcileError;
  375.   end;
  376.  
  377. implementation
  378.  
  379. uses DBConsts, ActiveX, ComObj;
  380.  
  381. { Exceptions }
  382.  
  383. constructor EDBClient.Create(Message: string; ErrorCode: DBIResult);
  384. begin
  385.   FErrorCode := ErrorCode;
  386.   inherited Create(Message);
  387. end;
  388.  
  389. constructor EReconcileError.Create(NativeError, Context: string; ErrorCode: DBIResult);
  390. begin
  391.   FContext := Context;
  392.   inherited Create(NativeError);
  393. end;
  394.  
  395. { Utility Routines }
  396.  
  397. procedure CheckDataPacket(DataPacket: OleVariant);
  398. begin
  399.   if not (VarIsArray(DataPacket) and (VarArrayHighBound(DataPacket, 1) > 20)) then
  400.     DatabaseError(SInvalidDataPacket);
  401. end;
  402.  
  403. type
  404.  
  405. { TDSBlobStream }
  406.  
  407.   TDSBlobStream = class(TMemoryStream)
  408.   private
  409.     FField: TBlobField;
  410.     FDataSet: TClientDataSet;
  411.     FBuffer: PChar;
  412.     FFieldNo: Integer;
  413.     FModified: Boolean;
  414.     procedure ReadBlobData;
  415.   public
  416.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  417.     destructor Destroy; override;
  418.     function Write(const Buffer; Count: Longint): Longint; override;
  419.     procedure Truncate;
  420.   end;
  421.  
  422.  
  423. constructor TDSBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
  424. begin
  425.   FField := Field;
  426.   FFieldNo := FField.FieldNo;
  427.   FDataSet := FField.DataSet as TClientDataSet;
  428.   if not FDataSet.GetActiveRecBuf(FBuffer) then Exit;
  429.   if Mode <> bmRead then
  430.   begin
  431.     if FField.ReadOnly then DatabaseErrorFmt(SFieldReadOnly, [FField.DisplayName]);
  432.     if not (FDataSet.State in [dsEdit, dsInsert]) then DatabaseError(SNotEditing);
  433.   end;
  434.   if Mode = bmWrite then Truncate
  435.   else ReadBlobData;
  436. end;
  437.  
  438. destructor TDSBlobStream.Destroy;
  439. begin
  440.   if FModified then
  441.   try
  442.     FDataSet.Check(FDataSet.FDSCursor.PutBlob(FBuffer, FFieldNo, 0, Memory, Size));
  443.     FField.Modified := True;
  444.     FDataSet.DataEvent(deFieldChange, Longint(FField));
  445.   except
  446.     Application.HandleException(Self);
  447.   end;
  448. end;
  449.  
  450. procedure TDSBlobStream.ReadBlobData;
  451. var
  452.   BlobLen: Integer;
  453. begin
  454.   FDataSet.Check(FDataSet.FDSCursor.GetBlobLen(FBuffer, FFieldNo, BlobLen));
  455.   if BlobLen > 0 then
  456.   begin
  457.     Position := 0;
  458.     SetSize(BlobLen);
  459.     FDataSet.Check(FDataSet.FDSCursor.GetBlob(FBuffer, FFieldNo, 0, Memory, BlobLen));
  460.   end;
  461. end;
  462.  
  463. function TDSBlobStream.Write(const Buffer; Count: Longint): Longint;
  464. begin
  465.   Result := inherited Write(Buffer, Count);
  466.   FModified := True;
  467. end;
  468.  
  469. procedure TDSBlobStream.Truncate;
  470. begin
  471.   Clear;
  472.   FModified := True;
  473. end;
  474.  
  475. { TCustomRemoteServer }
  476.  
  477. procedure TCustomRemoteServer.AddDataSet(DataSet: TClientDataSet);
  478. begin
  479. end;
  480.  
  481. procedure TCustomRemoteServer.RemoveDataSet(DataSet: TClientDataSet);
  482. begin
  483. end;
  484.  
  485. function TCustomRemoteServer.GetConnected: Boolean;
  486. begin
  487.   Result := False;
  488. end;
  489.  
  490. type
  491.  
  492. { TDispatchProvider }
  493.  
  494.   TDispatchProvider = class(TInterfacedObject, IProvider)
  495.   private
  496.     FProvider: DProvider;
  497.     { IDispatch }
  498.     function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
  499.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
  500.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  501.       NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
  502.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  503.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
  504.     { IProvider }
  505.     function Get_Data: OleVariant; safecall;
  506.     function ApplyUpdates(Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer): OleVariant; safecall;
  507.     function GetMetaData: OleVariant; safecall;
  508.     function GetRecords(Count: Integer; out RecsOut: Integer): OleVariant; safecall;
  509.     function DataRequest(Input: OleVariant): OleVariant; safecall;
  510.     function Get_Constraints: WordBool; safecall;
  511.     procedure Set_Constraints(Value: WordBool); safecall;
  512.     procedure Reset; safecall;
  513.   public
  514.     constructor Create(const Provider: DProvider);
  515.   end;
  516.  
  517. { TDispatchProvider }
  518.  
  519. constructor TDispatchProvider.Create(const Provider: DProvider);
  520. begin
  521.   FProvider := Provider;
  522. end;
  523.  
  524. { TDispatchProvider.IDispatch }
  525.  
  526. function TDispatchProvider.GetTypeInfoCount(out Count: Integer): Integer;
  527. begin
  528.   Result := IDispatch(FProvider).GetTypeInfoCount(Count);
  529. end;
  530.  
  531. function TDispatchProvider.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer;
  532. begin
  533.   Result := IDispatch(FProvider).GetTypeInfo(Index, LocaleID, TypeInfo);
  534. end;
  535.  
  536. function TDispatchProvider.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  537.   NameCount, LocaleID: Integer; DispIDs: Pointer): Integer;
  538. begin
  539.   Result := IDispatch(FProvider).GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs);
  540. end;
  541.  
  542. function TDispatchProvider.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  543.   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer;
  544. begin
  545.   Result := IDispatch(FProvider).Invoke(DispID, IID, LocaleID, Flags, Params,
  546.     VarResult, ExcepInfo, ArgErr);
  547. end;
  548.  
  549. { TDispatchProvider.IProvider }
  550.  
  551. function TDispatchProvider.Get_Data: OleVariant;
  552. begin
  553.   Result := FProvider.Data;
  554. end;
  555.  
  556. function TDispatchProvider.ApplyUpdates(Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer): OleVariant;
  557. begin
  558.   Result := FProvider.ApplyUpdates(Delta, MaxErrors, ErrorCount);
  559. end;
  560.  
  561. function TDispatchProvider.GetMetaData: OleVariant;
  562. begin
  563.   Result := FProvider.GetMetaData;
  564. end;
  565.  
  566. function TDispatchProvider.GetRecords(Count: Integer; out RecsOut: Integer): OleVariant;
  567. begin
  568.   Result := FProvider.GetRecords(Count, RecsOut);
  569. end;
  570.  
  571. function TDispatchProvider.DataRequest(Input: OleVariant): OleVariant;
  572. begin
  573.   Result := FProvider.DataRequest(Input);
  574. end;
  575.  
  576. function TDispatchProvider.Get_Constraints: WordBool;
  577. begin
  578.   Result := FProvider.Constraints;
  579. end;
  580.  
  581. procedure TDispatchProvider.Set_Constraints(Value: WordBool);
  582. begin
  583.   FProvider.Constraints := Value;
  584. end;
  585.  
  586. procedure TDispatchProvider.Reset;
  587. begin
  588.   FProvider.Reset;
  589. end;
  590.  
  591. { TRemoteServer }
  592.  
  593. function GetProperty(Obj: IDispatch; const Name: string): OleVariant;
  594. var
  595.   ID: Integer;
  596.   WideName: WideString;
  597.   DispParams: TDispParams;
  598.   ExcepInfo: TExcepInfo;
  599.   Status: Integer;
  600. begin
  601.   WideName := Name;
  602.   OleCheck(Obj.GetIDsOfNames(GUID_NULL, @WideName, 1, 0, @ID));
  603.   FillChar(DispParams, SizeOf(DispParams), 0);
  604.   FillChar(ExcepInfo, SizeOf(ExcepInfo), 0);
  605.   Status := Obj.Invoke(ID, GUID_NULL, 0, DISPATCH_PROPERTYGET, DispParams,
  606.     @Result, @ExcepInfo, nil);
  607.   if Status <> 0 then DispatchInvokeError(Status, ExcepInfo);
  608. end;
  609.  
  610. constructor TRemoteServer.Create(AOwner: TComponent);
  611. begin
  612.   inherited Create(AOwner);
  613.   FDataSets := TList.Create;
  614. end;
  615.  
  616. destructor TRemoteServer.Destroy;
  617. begin
  618.   SetConnected(False);
  619.   FDataSets.Free;
  620.   inherited Destroy;
  621. end;
  622.  
  623. procedure TRemoteServer.Loaded;
  624. begin
  625.   inherited Loaded;
  626.   try
  627.     if FStreamedConnected then SetConnected(True);
  628.   except
  629.     if csDesigning in ComponentState then
  630.       Application.HandleException(Self)
  631.     else
  632.       raise;
  633.   end;
  634. end;
  635.  
  636. procedure TRemoteServer.SetComputerName(const Value: string);
  637. begin
  638.   if Value <> FComputerName then
  639.   begin
  640.     SetConnected(False);
  641.     FComputerName := Value;
  642.   end;
  643. end;
  644.  
  645. procedure TRemoteServer.SetServerName(const Value: string);
  646. begin
  647.   if Value <> FServerName then
  648.   begin
  649.     SetConnected(False);
  650.     FServerName := Value;
  651.   end;
  652. end;
  653.  
  654. procedure TRemoteServer.AddDataSet(DataSet: TClientDataSet);
  655. begin
  656.   FDataSets.Add(DataSet);
  657. end;
  658.  
  659. procedure TRemoteServer.RemoveDataSet(DataSet: TClientDataSet);
  660. begin
  661.   FDataSets.Remove(DataSet);
  662. end;
  663.  
  664. function TRemoteServer.GetConnected: Boolean;
  665. begin
  666.   Result := FDispatch <> nil;
  667. end;
  668.  
  669. procedure TRemoteServer.SetConnected(Value: Boolean);
  670. type
  671.   TCoCreateFunc = function(const clsid: TCLSID; unkOuter: IUnknown;
  672.     dwClsCtx: Longint; ServerInfo: PCoServerInfo; dwCount: Longint;
  673.     rgmqResults: PMultiQIArray): HResult; stdcall;
  674. var
  675.   I: Integer;
  676.   WideName: WideString;
  677.   ServerInfo: TCoServerInfo;
  678.   MultiQI: TMultiQI;
  679.   IDispatchID: TGuid;
  680.   Handle: HModule;
  681.   CoCreateInstanceEx: TCoCreateFunc;
  682. begin
  683.   if (csReading in ComponentState) and Value then
  684.     FStreamedConnected := True else
  685.   begin
  686.     if Value = GetConnected then Exit;
  687.     if Value then
  688.     begin
  689.       CoCreateInstanceEx := nil;
  690.       if ComputerName <> '' then
  691.       begin
  692.         FillChar(ServerInfo, SizeOf(ServerInfo), #0);
  693.         WideName := ComputerName;
  694.         ServerInfo.pwszName := PWideChar(WideName);
  695.         IDispatchID := IDispatch;
  696.         MultiQI.IID := @IDispatchID;
  697.         { Need to reference CoCreateInstanceEx dynamically to prevent
  698.           load errors when running under Win95 w/o DCOM. }
  699.         Handle := GetModuleHandle('OLE32.DLL');
  700.         Win32Check(Handle > HINSTANCE_ERROR);
  701.         CoCreateInstanceEx := GetProcAddress(Handle, 'CoCreateInstanceEx'); { Do not localize }
  702.       end;
  703.       if Assigned(CoCreateInstanceEx) then
  704.       begin
  705.         OleCheck(CoCreateInstanceEx(ProgIDToClassID(FServerName), nil,
  706.           CLSCTX_LOCAL_SERVER or CLSCTX_REMOTE_SERVER or CLSCTX_INPROC_SERVER,
  707.           @ServerInfo, 1, @MultiQI));
  708.         OleCheck(MultiQI.hr);
  709.         FDispatch := MultiQI.Itf as IDispatch;
  710.       end else
  711.        { If no machine name is specified or running under Win95 w/o DCOM,
  712.          support local servers using CoCreateInstance }
  713.         OleCheck(CoCreateInstance(ProgIDToClassID(FServerName), nil,
  714.           CLSCTX_LOCAL_SERVER or CLSCTX_INPROC_SERVER, IDispatch, FDispatch));
  715.       if Assigned(FOnConnect) then FOnConnect(Self);
  716.     end else
  717.     begin
  718.       for I := 0 to FDataSets.Count - 1 do
  719.         if Assigned(TClientDataSet(FDataSets[I]).FProvider) then
  720.           TClientDataSet(FDataSets[I]).FProvider := nil;
  721.       FDispatch := nil;
  722.       if Assigned(FOnDisconnect) then FOnDisconnect(Self);
  723.     end;
  724.   end;
  725. end;
  726.  
  727. function TRemoteServer.GetProvider(const ProviderName: string): IProvider;
  728. var
  729.   ProviderDispatch: IDispatch;
  730. begin
  731.   SetConnected(True);
  732.   ProviderDispatch := IDispatch(GetProperty(FDispatch, ProviderName));
  733.   if ProviderDispatch.QueryInterface(IProvider, Result) <> 0 then
  734.     Result := TDispatchProvider.Create(DProvider(ProviderDispatch));
  735. end;
  736.  
  737. { TClientDataSet }
  738.  
  739. constructor TClientDataSet.Create(AOwner: TComponent);
  740. begin
  741.   inherited Create(AOwner);
  742.   FData := System.Null;
  743.   FMasterLink := TMasterDataLink.Create(Self);
  744.   FMasterLink.OnMasterChange := MasterChanged;
  745.   FMasterLink.OnMasterDisable := MasterDisabled;
  746.   FPacketRecords := -1;
  747.   FFetchOnDemand := True;
  748. end;
  749.  
  750. destructor TClientDataSet.Destroy;
  751. begin
  752.   Close;
  753.   inherited Destroy;
  754.   FMasterLink.Free;
  755.   if Assigned(FProvider) then
  756.     FProvider := nil;
  757.   FIndexDefs.Free;
  758. end;
  759.  
  760. function TClientDataSet.CreateDSBase: IDSBase;
  761. var
  762.   Status: HResult;
  763. begin
  764.   Status := CoCreateInstance(CLSID_DSBase, nil, CLSCTX_INPROC_SERVER or
  765.     CLSCTX_LOCAL_SERVER, IDSBase, Result);
  766.   if Status = S_OK then Exit;
  767.   if Status = REGDB_E_CLASSNOTREG then
  768.     RegisterComServer('DBCLIENT.DLL') else
  769.     OleCheck(Status);
  770.   Result := CreateComObject(CLSID_DSBase) as IDSBase;
  771. end;
  772.  
  773. function TClientDataSet.CreateDSCursor(SourceCursor: IDSCursor): IDSCursor;
  774. begin
  775.   Result := CreateComObject(CLSID_DSCursor) as IDSCursor;
  776.   if Assigned(SourceCursor) then
  777.     Check(Result.CloneCursor(SourceCursor)) else
  778.     Check(Result.InitCursor(FDSBase));
  779. end;
  780.  
  781. procedure TClientDataSet.OpenCursor(InfoQuery: Boolean);
  782. var
  783.   RecsOut: Integer;
  784. begin
  785.   FProviderEOF := True;
  786.   if not Assigned(FDSBase) then
  787.   begin
  788.     if VarIsNull(FData) then
  789.     begin
  790.       Provider.Reset;
  791.       FData := FProvider.GetRecords(FPacketRecords, RecsOut);
  792.       FProviderEOF := RecsOut <> FPacketRecords;
  793.     end;
  794.     if VarIsNull(FData) then DatabaseError(SNoDataProvider);
  795.     begin
  796.       FDSBase := CreateDSBase;
  797.       Check(FDSBase.AppendData(TVarData(FData).VArray, FProviderEOF));
  798.     end;
  799.   end;
  800.   inherited OpenCursor(InfoQuery);
  801.   if Assigned(FCloneSource) and not FCloneSource.BOF then
  802.   begin
  803.     SyncCursors(FDSCursor, FCloneSource.FDSCursor);
  804.     CursorPosChanged;
  805.     Resync([]);
  806.   end;
  807. end;
  808.  
  809. procedure TClientDataSet.Check(Status: DBIResult);
  810. var
  811.   ErrMsg: array[0..2048] of Char;
  812. begin
  813.   if Status <> 0 then
  814.   begin
  815.     FDSBase.GetErrorString(Status, ErrMsg);
  816.     raise EDBClient.Create(ErrMsg, Status);
  817.   end;
  818. end;
  819.  
  820. procedure TClientDataSet.CloseCursor;
  821. begin
  822.   inherited CloseCursor;
  823.   if Assigned(FProvider) then
  824.   begin
  825.     FData := NULL;
  826.     if Assigned(FRemoteServer) and FRemoteServer.Connected and
  827.       not (csDestroying in ComponentState) then
  828.     begin
  829.       FProvider.Reset;
  830.       FProvider := nil;
  831.     end;
  832.   end;
  833.   FDSBase := nil;
  834. end;
  835.  
  836. procedure TClientDataSet.InternalInitFieldDefs;
  837. var
  838.   I: Integer;
  839.   FieldDescs: PFieldDescList;
  840.   CursorProps: DSProps;
  841. begin
  842.   Check(FDSBase.GetProps(CursorProps));
  843.   FieldDescs := AllocMem(CursorProps.iFields * SizeOf(DSFLDDesc));
  844.   try
  845.     Check(FDSBase.GetFieldDescs(PDSFldDesc(FieldDescs)));
  846.     FieldDefs.Clear;
  847.     for I := 0 to CursorProps.iFields - 1 do
  848.       AddFieldDesc(FieldDescs^[I], False, I + 1);
  849.   finally
  850.     FreeMem(FieldDescs, CursorProps.iFields * SizeOf(DSFLDDesc));
  851.   end;
  852. end;
  853.  
  854. procedure TClientDataSet.InternalOpen;
  855. var
  856.   CursorProps: DSProps;
  857. begin
  858.   if not DefaultFields then SetupInternalCalcFields;
  859.   if Assigned(FCloneSource) then
  860.     FDSCursor := CreateDSCursor(FCloneSource.FDSCursor) else
  861.     FDSCursor := CreateDSCursor(nil);
  862.   Check(FDSCursor.GetCursorProps(CursorProps));
  863.   FRecordSize := CursorProps.iRecBufSize;
  864.   BookmarkSize := CursorProps.iBookmarkSize;
  865.   FCanModify := not CursorProps.bReadOnly;
  866.   InternalInitFieldDefs;
  867.   GetIndexInfo;
  868.   if DefaultFields then CreateFields;
  869.   BindFields(True);
  870.   InitBufferPointers(False);
  871.   AllocKeyBuffers;
  872.   if InternalCalcFields then
  873.     Check(FDSBase.SetFieldCalculation(Integer(Self),
  874.       @TClientDataSet.CalcFieldsCallback));
  875.   FDSCursor.MoveToBOF;
  876.   if not Assigned(FCloneSource) then
  877.   begin
  878.     if FIndexName <> '' then
  879.        if FFieldsIndex then
  880.          SortOnFields(FDSCursor, FIndexName, False, False) else
  881.          Check(FDSCursor.UseIndexOrder(PChar(FIndexName)));
  882.     CheckMasterRange;
  883.     if Filtered then ActivateFilters;
  884.     if FReadOnly then FDSBase.SetProp(dspropREADONLY, Integer(True));
  885.   end;
  886. end;
  887.  
  888. procedure TClientDataSet.InternalClose;
  889. begin
  890.   if Filtered then DeactivateFilters;
  891.   FreeKeyBuffers;
  892.   BindFields(False);
  893.   if DefaultFields then DestroyFields;
  894.   FIndexFieldCount := 0;
  895.   FKeySize := 0;
  896.   FDSCursor := nil;
  897.   FLookupCursor := nil;
  898.   FFindCursor := nil;
  899. end;
  900.  
  901. function TClientDataSet.IsCursorOpen: Boolean;
  902. begin
  903.   Result := FDSCursor <> nil;
  904. end;
  905.  
  906. procedure TClientDataSet.InternalHandleException;
  907. begin
  908.   Application.HandleException(Self)
  909. end;
  910.  
  911. procedure TClientDataSet.SetData(Value: OleVariant);
  912. begin
  913.   Close;
  914.   if VarIsNull(Value) then FData := System.NULL else
  915.   begin
  916.     CheckDataPacket(Value);
  917.     FData := Value;
  918.     Open;
  919.   end;
  920. end;
  921.  
  922. function TClientDataSet.GetData: OleVariant;
  923. var
  924.   DataPacket: PVarArray;
  925. begin
  926.   CheckBrowseMode;
  927.   Check(FDSBase.StreamDS(DataPacket));
  928.   Result := SafeArrayToVariant(DataPacket);
  929. end;
  930.  
  931. procedure TClientDataSet.FetchMoreData(All: Boolean);
  932. var
  933.   Count: Integer;
  934.   RecsOut: Integer;
  935. begin
  936.   if All then Count := -1 else Count := FPacketRecords;
  937.   AddDataPacket(Provider.GetRecords(Count, RecsOut), RecsOut <> Count);
  938.   FProviderEOF := RecsOut <> Count;
  939. end;
  940.  
  941. procedure TClientDataSet.CheckProviderEOF;
  942. begin
  943.   if not FProviderEOF and FFetchOnDemand then FetchMoreData(True);
  944. end;
  945.  
  946. procedure TClientDataSet.AddDataPacket(Data: OleVariant; HitEOF: Boolean);
  947. begin
  948.   if not VarIsNull(Data) then CheckDataPacket(Data);
  949.   Check(FDSBase.AppendData(TVarData(Data).VArray, HitEOF));
  950. end;
  951.  
  952. procedure TClientDataSet.AppendData(Data: OleVariant; HitEOF: Boolean);
  953. begin
  954.   CheckBrowseMode;
  955.   UpdateCursorPos;
  956.   AddDataPacket(Data, HitEOF);
  957.   Resync([]);
  958. end;
  959.  
  960. function TClientDataSet.GetNextPacket: Integer;
  961. begin
  962.   if FProviderEOF then Result := 0 else
  963.   begin
  964.     AddDataPacket(Provider.GetRecords(FPacketRecords, Result),
  965.       Result <> FPacketRecords);
  966.     FProviderEOF := Result <> FPacketRecords
  967.   end;
  968. end;
  969.  
  970. procedure TClientDataSet.SetProviderName(const Value: string);
  971. begin
  972.   CheckInactive;
  973.   FProvider := nil;
  974.   FData := NULL;
  975.   FProviderName := Value;
  976. end;
  977.  
  978. function TClientDataSet.GetProvider: IProvider;
  979. begin
  980.   if not Assigned(FProvider) then
  981.   begin
  982.     if Assigned(RemoteServer) and (ProviderName <> '') then
  983.       FProvider := RemoteServer.GetProvider(ProviderName);
  984.     if not Assigned(FProvider) then DatabaseError(SNoDataProvider);
  985.   end;
  986.   Result := FProvider;
  987. end;
  988.  
  989. procedure TClientDataSet.SetProvider(Value: IProvider);
  990. begin
  991.   FProvider := Value;
  992. end;
  993.  
  994. procedure TClientDataSet.SetRemoteServer(Value: TCustomRemoteServer);
  995. begin
  996.   if Value = FRemoteServer then Exit;
  997.   CheckInactive;
  998.   FProvider := nil;
  999.   FData := NULL;
  1000.   if Assigned(FRemoteServer) then FRemoteServer.RemoveDataSet(Self);
  1001.   if Assigned(Value) then Value.AddDataSet(Self);
  1002.   FRemoteServer := Value;
  1003. end;
  1004.  
  1005. procedure TClientDataSet.Notification(AComponent: TComponent; Operation: TOperation);
  1006. begin
  1007.   inherited Notification(AComponent, Operation);
  1008.   if (Operation = opRemove) and (FRemoteServer <> nil) and
  1009.     (AComponent = FRemoteServer) then
  1010.   begin
  1011.     FRemoteServer := nil;
  1012.   end;
  1013. end;
  1014.  
  1015. function TClientDataSet.GetDelta: OleVariant;
  1016. var
  1017.   FDeltaDS: IDSBase;
  1018.   DataPacket: PVarArray;
  1019. begin
  1020.   CheckBrowseMode;
  1021.   Check(FDSBase.GetDelta(FDeltaDS));
  1022.   Check(FDeltaDS.StreamDS(DataPacket));
  1023.   FDelta := SafeArrayToVariant(DataPacket);
  1024.   Result := FDelta;
  1025. end;
  1026.  
  1027. function TClientDataSet.ApplyUpdates(MaxErrors: Integer): Integer;
  1028. begin
  1029.   if ChangeCount = 0 then Result := 0 else
  1030.   begin
  1031.     Reconcile(Provider.ApplyUpdates(Delta, MaxErrors, Result));
  1032.   end;
  1033. end;
  1034.  
  1035. procedure TClientDataSet.ClearChangeLog;
  1036. begin
  1037.   CheckBrowseMode;
  1038.   FDSBase.AcceptChanges;
  1039. end;
  1040.  
  1041. procedure TClientDataSet.SetAltRecBuffers(Old, New, Cur: PChar);
  1042. begin
  1043.   FOldValueBuffer := Old;
  1044.   FNewValueBuffer := New;
  1045.   FCurValueBuffer := Cur;
  1046. end;
  1047.  
  1048. function TClientDataSet.ReconcileCallback(
  1049.     iRslt         : Integer;   { Previous error if any }
  1050.     iUpdateKind   : DSAttr;    { Update request Insert/Modify/Delete }
  1051.     iResAction    : dsCBRType; { Resolver response }
  1052.     iErrCode      : Integer;   { Native error-code, (BDE or ..) }
  1053.     pErrMessage,               { Native errormessage, if any (otherwise NULL) }
  1054.     pErrContext   : PChar;     { 1-level error context, if any (otherwise NULL) }
  1055.     pRecUpd,                   { Record that failed update }
  1056.     pRecOrg,                   { Original record, if any }
  1057.     pRecConflict  : Pointer    { Conflicting error, if any }
  1058. ): dsCBRType;
  1059. var
  1060.   Action: TReconcileAction;
  1061.   UpdateKind: TUpdateKind;
  1062. begin
  1063.   FInReconcileCallback := True;
  1064.   try
  1065.     SetAltRecBuffers(pRecOrg, pRecUpd, pRecConflict);
  1066.     if iUpdateKind = dsRecDeleted then
  1067.       UpdateKind := ukDelete
  1068.     else if iUpdateKind = dsRecNew then
  1069.       UpdateKind := ukInsert
  1070.     else
  1071.       UpdateKind := ukModify;
  1072.     if iResAction = dscbrSkip then
  1073.       Action := raSkip else
  1074.       Action := raAbort;
  1075.     try
  1076.       raise EReconcileError.Create(pErrMessage, pErrContext, iErrCode);
  1077.     except
  1078.       on E: EReconcileError do
  1079.         FOnReconcileError(Self, E, UpdateKind, Action);
  1080.     end;
  1081.   except
  1082.     Application.HandleException(Self);
  1083.     Action := raAbort;
  1084.   end;
  1085.   Result := Ord(Action) + 1;
  1086.   FInReconcileCallback := False;
  1087. end;
  1088.  
  1089. function TClientDataSet.Reconcile(Results: OleVariant): Boolean;
  1090. var
  1091.   RCB: Pointer;
  1092. begin
  1093.   if VarIsNull(Results) then ClearChangeLog else
  1094.   begin
  1095.     CheckDataPacket(Results);
  1096.     UpdateCursorPos;
  1097.     if Assigned(FOnReconcileError) then
  1098.       RCB := @TClientDataSet.ReconcileCallback else
  1099.       RCB := nil;
  1100.     Check(FDSBase.Reconcile(TVarData(FDelta).VArray, TVarData(Results).VArray,
  1101.       Integer(Self), RCB));
  1102.     Resync([]);
  1103.   end;
  1104.   Result := (ChangeCount = 0);
  1105. end;
  1106.  
  1107. procedure TClientDataSet.NotifyCallback;
  1108. begin
  1109.   if State = dsBrowse then Refresh;
  1110. end;
  1111.  
  1112. procedure TClientDataSet.SetNotifyCallback;
  1113. begin
  1114.   if not FNotifyCallback then
  1115.   begin
  1116.     Check(FDSCursor.SetNotifyCallBack(Integer(Self), @TClientDataSet.NotifyCallback));
  1117.     FNotifyCallback := True;
  1118.   end;
  1119. end;
  1120.  
  1121. procedure TClientDataSet.CloneCursor(Source: TClientDataSet; Reset: Boolean);
  1122. begin
  1123.   Source.CheckActive;
  1124.   Close;
  1125.   FDSBase := Source.DSBase;
  1126.   Source.UpdateCursorPos;
  1127.   if not Reset then
  1128.   begin
  1129.     FCloneSource := Source;
  1130.     Filter := Source.Filter;
  1131.     OnFilterRecord := Source.OnFilterRecord;
  1132.     FilterOptions := Source.FilterOptions;
  1133.     Filtered := Source.Filtered;
  1134.     if Source.IndexName <> '' then
  1135.       IndexName := Source.IndexName else
  1136.       IndexFieldNames := Source.IndexFieldNames;
  1137.     MasterSource := Source.MasterSource;
  1138.     MasterFields := Source.MasterFields;
  1139.     ReadOnly := Source.ReadOnly;
  1140.     RemoteServer := Source.RemoteServer;
  1141.     ProviderName := Source.ProviderName;
  1142.     Provider := Source.Provider;
  1143.   end;
  1144.   try
  1145.     Open;
  1146.   finally
  1147.     FCloneSource := nil;
  1148.   end;
  1149.   SetNotifyCallback;
  1150.   Source.SetNotifyCallback;
  1151. end;
  1152.  
  1153. procedure TClientDataSet.EncodeFieldDesc(var FieldDesc: DSFLDDesc;
  1154.   const Name: string; DataType: TFieldType; Size: Word; Calculated: Boolean);
  1155. begin
  1156.   with FieldDesc do
  1157.   begin
  1158.     FillChar(FieldDesc, SizeOf(FieldDesc), #0);
  1159.     StrCopy(szName, PChar(Name));
  1160.     iFldType := FldTypeMap[DataType];
  1161.     iFldSubType := FldSubTypeMap[DataType];
  1162.     bCalculated := Calculated;
  1163.     case DataType of
  1164.       ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic,
  1165.       ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary:
  1166.         iUnits1 := Size;
  1167.       ftBCD:
  1168.         begin
  1169.           iUnits1 := 32;
  1170.           iUnits2 := Size;
  1171.         end;
  1172.     end;
  1173.   end;
  1174. end;
  1175.  
  1176. procedure TClientDataSet.CreateDataSet;
  1177. var
  1178.   I: Integer;
  1179.   FieldDescs: pDSFLDDesc;
  1180.   IndexDesc: DSIdxDesc;
  1181. begin
  1182.   CheckInactive;
  1183.   if FieldDefs.Count = 0 then
  1184.     for I := 0 to FieldCount - 1 do
  1185.       with Fields[I] do
  1186.         if FieldKind = fkData then
  1187.           FieldDefs.Add(FieldName, DataType, Size, Required);
  1188.   FieldDescs := AllocMem(FieldDefs.Count * SizeOf(DSFLDDesc));
  1189.   try
  1190.     for I := 0 to FieldDefs.Count - 1 do
  1191.       with FieldDefs[I] do
  1192.         EncodeFieldDesc(PFieldDescList(FieldDescs)^[I], Name, DataType, Size, False);
  1193.     FDSBase := CreateDSBase;
  1194.     Check(FDSBase.Create(FieldDefs.Count, FieldDescs, PChar(Name)));
  1195.     try
  1196.       for I := 0 to IndexDefs.Count - 1 do
  1197.       begin
  1198.         with IndexDefs[I] do
  1199.           EncodeIndexDesc(IndexDesc, Name, Fields, Options);
  1200.         Check(FDSBase.CreateIndex(IndexDesc));
  1201.       end;
  1202.     except
  1203.       FDSBase := nil;
  1204.       raise;
  1205.     end;
  1206.     Open;
  1207.   finally
  1208.     FreeMem(FieldDescs, FieldDefs.Count * SizeOf(DSFLDDesc));
  1209.   end;
  1210. end;
  1211.  
  1212. procedure TClientDataSet.SetupInternalCalcFields;
  1213. var
  1214.   I: Integer;
  1215.   FieldDesc: DSFLDDesc;
  1216. begin
  1217.   for I := 0 to FieldCount - 1 do
  1218.   begin
  1219.     if Fields[I].FieldKind = fkInternalCalc then
  1220.       with Fields[I] do
  1221.       begin
  1222.         EncodeFieldDesc(FieldDesc, FieldName, DataType, Size, True);
  1223.         FDSBase.AddField(@FieldDesc);
  1224.       end;
  1225.   end;
  1226. end;
  1227.  
  1228. procedure TClientDataSet.LoadFromStream(Stream: TStream);
  1229. var
  1230.   VarData: Pointer;
  1231.   StreamData: OleVariant;
  1232. begin
  1233.   with Stream do
  1234.   begin
  1235.     StreamData := VarArrayCreate([0, Size-1], varByte);
  1236.     VarData := VarArrayLock(StreamData);
  1237.     try
  1238.       Read(VarData^, Size);
  1239.     finally
  1240.       VarArrayUnlock(StreamData);
  1241.     end;
  1242.     Data := StreamData;
  1243.   end;
  1244. end;
  1245.  
  1246. procedure TClientDataSet.LoadFromFile(const FileName: string);
  1247. var
  1248.   Stream: TStream;
  1249. begin
  1250.   Stream := TFileStream.Create(FileName, fmOpenRead);
  1251.   try
  1252.     LoadFromStream(Stream);
  1253.   finally
  1254.     Stream.Free;
  1255.   end;
  1256. end;
  1257.  
  1258. procedure TClientDataSet.SaveToStream(Stream: TStream);
  1259. var
  1260.   DataPtr: Pointer;
  1261.   DataPacket: PVarArray;
  1262.   Size: Integer;
  1263. begin
  1264.   CheckBrowseMode;
  1265.   CheckProviderEOF;
  1266.   Check(FDSBase.StreamDS(DataPacket));
  1267.   SafeArrayGetUBound(PSafeArray(DataPacket), 1, Size);
  1268.   SafeArrayAccessData(PSafeArray(DataPacket), DataPtr);
  1269.   try
  1270.     Stream.Write(DataPtr^, Size + 1);
  1271.   finally
  1272.     SafeArrayUnAccessData(PSafeArray(DataPacket));
  1273.   end;
  1274. end;
  1275.  
  1276. procedure TClientDataSet.SaveToFile(const FileName: string);
  1277. var
  1278.   Stream: TStream;
  1279. begin
  1280.   Stream := TFileStream.Create(FileName, fmCreate);
  1281.   try
  1282.     SaveToStream(Stream);
  1283.   finally
  1284.     Stream.Free;
  1285.   end;
  1286. end;
  1287.  
  1288. procedure TClientDataSet.SetLogChanges(Value: Boolean);
  1289. begin
  1290.   CheckBrowseMode;
  1291.   Check(FDSBase.SetProp(dspropLOGCHANGES, Integer(Value)));
  1292. end;
  1293.  
  1294. function TClientDataSet.GetLogChanges: Boolean;
  1295. var
  1296.   LogChanges: Integer;
  1297. begin
  1298.   CheckBrowseMode;
  1299.   Check(FDSBase.GetProp(dspropLOGCHANGES, LogChanges));
  1300.   Result := Boolean(LogChanges);
  1301. end;
  1302.  
  1303. function TClientDataSet.GetCanModify: Boolean;
  1304. begin
  1305.   Result := FCanModify and not ReadOnly;
  1306. end;
  1307.  
  1308. procedure TClientDataSet.DisableConstraints;
  1309. begin
  1310.   if FConstDisableCount = 0 then
  1311.     Check(FDSBase.SetProp(dspropCONSTRAINTS_DISABLED, Longint(True)));
  1312.   Inc(FConstDisableCount);
  1313. end;
  1314.  
  1315. procedure TClientDataSet.EnableConstraints;
  1316. begin
  1317.   if FConstDisableCount <> 0 then
  1318.   begin
  1319.     Dec(FConstDisableCount);
  1320.     if FConstDisableCount = 0 then
  1321.       Check(FDSBase.SetProp(dspropCONSTRAINTS_DISABLED, Longint(False)));
  1322.   end;
  1323. end;
  1324.  
  1325. { Record Functions }
  1326.  
  1327. procedure TClientDataSet.InitBufferPointers(GetProps: Boolean);
  1328. var
  1329.   CursorProps: DSProps;
  1330. begin
  1331.   if GetProps then
  1332.   begin
  1333.     Check(FDSCursor.GetCursorProps(CursorProps));
  1334.     BookmarkSize := CursorProps.iBookmarkSize;
  1335.     FRecordSize := CursorProps.iRecBufSize;
  1336.   end;
  1337.   FRecInfoOfs := FRecordSize + CalcFieldsSize;
  1338.   FBookmarkOfs := FRecInfoOfs + SizeOf(TRecInfo);
  1339.   FRecBufSize := FBookmarkOfs + BookmarkSize;
  1340. end;
  1341.  
  1342. function TClientDataSet.AllocRecordBuffer: PChar;
  1343. begin
  1344.   Result := StrAlloc(FRecBufSize);
  1345. end;
  1346.  
  1347. procedure TClientDataSet.FreeRecordBuffer(var Buffer: PChar);
  1348. begin
  1349.   StrDispose(Buffer);
  1350. end;
  1351.  
  1352. procedure TClientDataSet.InternalInitRecord(Buffer: PChar);
  1353. begin
  1354.   Check(FDSCursor.InitRecord(Buffer));
  1355. end;
  1356.  
  1357. procedure TClientDataSet.ClearCalcFields(Buffer: PChar);
  1358. begin
  1359.   FillChar(Buffer[RecordSize], CalcFieldsSize, 0);
  1360. end;
  1361.  
  1362. procedure TClientDataSet.InitRecord(Buffer: PChar);
  1363. begin
  1364.   inherited InitRecord(Buffer);
  1365.   with PRecInfo(Buffer + FRecInfoOfs)^ do
  1366.   begin
  1367.     BookMarkFlag := bfInserted;
  1368.     RecordNumber := -1;
  1369.     Attribute := dsRecNew;
  1370.   end;
  1371. end;
  1372.  
  1373. function TClientDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
  1374.   DoCheck: Boolean): TGetResult;
  1375. var
  1376.   Status: DBIResult;
  1377. begin
  1378.   with FDSCursor do
  1379.   begin
  1380.     case GetMode of
  1381.       gmNext:
  1382.         begin
  1383.           Status := MoveRelative(1);
  1384.           if (Status = DBIERR_EOF) and not FProviderEOF and FFetchOnDemand then
  1385.           begin
  1386.             MoveRelative(-1);
  1387.             FetchMoreData(False);
  1388.             Status := MoveRelative(1);
  1389.           end;
  1390.         end;
  1391.       gmPrior: Status := MoveRelative(-1);
  1392.     else
  1393.       Status := DBIERR_NONE;
  1394.     end;
  1395.     if Status = DBIERR_NONE then
  1396.       Status := GetCurrentRecord(Buffer);
  1397.     case Status of
  1398.       DBIERR_NONE:
  1399.         begin
  1400.           with PRecInfo(Buffer + FRecInfoOfs)^ do
  1401.           begin
  1402.             BookmarkFlag := bfCurrent;
  1403.             GetSequenceNumber(RecordNumber);
  1404.             GetRecordAttribute(Attribute);
  1405.           end;
  1406.           GetCalcFields(Buffer);
  1407.           Check(GetCurrentBookmark(Buffer + FBookmarkOfs));
  1408.           Result := grOK;
  1409.         end;
  1410.       DBIERR_BOF: Result := grBOF;
  1411.       DBIERR_EOF: Result := grEOF;
  1412.     else
  1413.       Result := grError;
  1414.       if DoCheck then Check(Status);
  1415.     end;
  1416.   end;
  1417. end;
  1418.  
  1419. function TClientDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
  1420. begin
  1421.   if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  1422.   begin
  1423.     UpdateCursorPos;
  1424.     Result := (FDSCursor.GetCurrentRecord(Buffer) = DBIERR_NONE);
  1425.   end else
  1426.     Result := False;
  1427. end;
  1428.  
  1429. function TClientDataSet.GetRecordCount: Integer;
  1430. begin
  1431.   CheckActive;
  1432.   Check(FDSCursor.GetRecordCount(Result));
  1433. end;
  1434.  
  1435. function TClientDataSet.GetRecNo: Integer;
  1436. var
  1437.   BufPtr: PChar;
  1438. begin
  1439.   CheckActive;
  1440.   if State = dsCalcFields then
  1441.     BufPtr := CalcBuffer else
  1442.     BufPtr := ActiveBuffer;
  1443.   Result := PRecInfo(BufPtr + FRecInfoOfs).RecordNumber;
  1444. end;
  1445.  
  1446. procedure TClientDataSet.SetRecNo(Value: Integer);
  1447. begin
  1448.   CheckBrowseMode;
  1449.   Check(FDSCursor.MoveToSeqNo(Value));
  1450.   Resync([]);
  1451. end;
  1452.  
  1453. function TClientDataSet.GetRecordSize: Word;
  1454. begin
  1455.   Result := FRecordSize;
  1456. end;
  1457.  
  1458. function TClientDataSet.GetActiveRecBuf(var RecBuf: PChar): Boolean;
  1459. begin
  1460.   case State of
  1461.     dsBrowse: if IsEmpty then RecBuf := nil else RecBuf := ActiveBuffer;
  1462.     dsEdit, dsInsert: RecBuf := ActiveBuffer;
  1463.     dsSetKey: RecBuf := PChar(FKeyBuffer) + SizeOf(TKeyBuffer);
  1464.     dsCalcFields: RecBuf := CalcBuffer;
  1465.     dsFilter: RecBuf := FFilterBuffer;
  1466.     dsNewValue: RecBuf := FNewValueBuffer;
  1467.     dsOldValue: RecBuf := FOldValueBuffer;
  1468.     dsCurValue: RecBuf := FCurValueBuffer;
  1469.     dsInActive: RecBuf := nil;
  1470.   else
  1471.     RecBuf := nil;
  1472.   end;
  1473.   Result := RecBuf <> nil;
  1474. end;
  1475.  
  1476. function TClientDataSet.GetChangeCount: Integer;
  1477. begin
  1478.   if Active then
  1479.     Check(FDSBase.GetProp(dspropNOOFCHANGES, Result)) else
  1480.     Result := 0;
  1481. end;
  1482.  
  1483. function TClientDataSet.UpdateStatus: TUpdateStatus;
  1484. var
  1485.   BufPtr: PChar;
  1486.   Attr: Byte;
  1487. begin
  1488.   CheckActive;
  1489.   if State = dsCalcFields then
  1490.     BufPtr := CalcBuffer else
  1491.     BufPtr := ActiveBuffer;
  1492.   Attr := PRecInfo(BufPtr + FRecInfoOfs).Attribute;
  1493.   if Attr = 0 then
  1494.     Result := usUnModified
  1495.   else if (Attr and dsRecDeleted) <> 0 then
  1496.     Result := usDeleted
  1497.   else if (Attr and dsRecNew) <> 0 then
  1498.     Result := usInserted
  1499.   else
  1500.     Result := usModified;
  1501. end;
  1502.  
  1503. { Field Related }
  1504.  
  1505. procedure TClientDataSet.AddFieldDesc(FieldDesc: DSFLDDesc; Required: Boolean;
  1506.   FieldNo: Word);
  1507. var
  1508.   DataType: TFieldType;
  1509.   Size: Word;
  1510.   I: Integer;
  1511.   Name: string;
  1512. begin
  1513.   with FieldDesc do
  1514.   begin
  1515.     if bHidden then Exit;  { Ignore hidden columns }
  1516.     I := 0;
  1517.     Name := szName;
  1518.     while FieldDefs.IndexOf(Name) >= 0 do
  1519.     begin
  1520.       Inc(I);
  1521.       Name := Format('%s_%d', [szName, I]);
  1522.     end;
  1523.     if iFldType < MAXLOGFLDTYPES then
  1524.       DataType := DataTypeMap[iFldType] else
  1525.       DataType := ftUnknown;
  1526.     Size := 0;
  1527.     case iFldType of
  1528.       fldZSTRING:
  1529.         Size := iUnits1;
  1530.       fldINT16, fldUINT16:
  1531.         if iFldLen <> 2 then DataType := ftUnknown;
  1532.       fldINT32:
  1533.         if iFldSubType = fldstAUTOINC then DataType := ftAutoInc;
  1534.       fldFLOAT:
  1535.         if iFldSubType = fldstMONEY then DataType := ftCurrency;
  1536.       fldBCD:
  1537.         Size := Abs(iUnits2);
  1538.       fldBYTES, fldVARBYTES:
  1539.         Size := iUnits1;
  1540.       fldBLOB:
  1541.         begin
  1542.           Size := iUnits1;
  1543.           if (iFldSubType >= fldstMEMO) and (iFldSubType <= fldstTYPEDBINARY) then
  1544.             DataType := BlobTypeMap[iFldSubType];
  1545.         end;
  1546.     end;
  1547.     if DataType <> ftUnknown then
  1548.       with TFieldDef.Create(FieldDefs, Name, DataType, Size, Required, FieldNo) do
  1549.         InternalCalcField := FieldDesc.bCalculated;
  1550.   end;
  1551. end;
  1552.  
  1553. function TClientDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  1554. var
  1555.   IsBlank: LongBool;
  1556.   RecBuf: PChar;
  1557. begin
  1558.   Result := False;
  1559.   if GetActiveRecBuf(RecBuf) then
  1560.     with Field do
  1561.       if FieldKind in [fkData, fkInternalCalc] then
  1562.       begin
  1563.         Check(FDSCursor.GetField(RecBuf, FieldNo, Buffer, IsBlank));
  1564.         Result := not IsBlank;
  1565.       end else
  1566.         if State in [dsBrowse, dsEdit, dsInsert, dsCalcFields] then
  1567.         begin
  1568.           Inc(RecBuf, FRecordSize + Offset);
  1569.           Result := Boolean(RecBuf[0]);
  1570.           if Result and (Buffer <> nil) then
  1571.             Move(RecBuf[1], Buffer^, DataSize);
  1572.         end;
  1573. end;
  1574.  
  1575. function TClientDataSet.GetStateFieldValue(State: TDataSetState; Field: TField): Variant;
  1576. var
  1577.   IsBlank: Integer;
  1578. begin
  1579.   if (State = dsNewValue) then
  1580.   begin
  1581.     if (FNewValueBuffer = nil) then
  1582.       IsBlank := BLANK_NOTCHANGED else
  1583.       Check(FDSCursor.GetField(FNewValueBuffer, Field.FieldNo, nil, LongBool(IsBlank)));
  1584.     if IsBlank = BLANK_NOTCHANGED then
  1585.     begin
  1586.       Result := UnAssigned;
  1587.       Exit;
  1588.     end;
  1589.  end;
  1590.  Result := inherited GetStateFieldValue(State, Field);
  1591. end;
  1592.  
  1593. procedure TClientDataSet.SetFieldData(Field: TField; Buffer: Pointer);
  1594. var
  1595.   RecBuf: PChar;
  1596. begin
  1597.   with Field do
  1598.   begin
  1599.     if not (State in dsWriteModes) then DatabaseError(SNotEditing);
  1600.     if (State = dsSetKey) and ((FieldNo < 0) or (FIndexFieldCount > 0) and
  1601.       not IsIndexField) then DatabaseErrorFmt(SNotIndexField, [DisplayName]);
  1602.     GetActiveRecBuf(RecBuf);
  1603.     if FieldKind in [fkData, fkInternalCalc] then
  1604.     begin
  1605.       if ReadOnly and not (State in [dsSetKey, dsFilter]) then
  1606.         DatabaseErrorFmt(SFieldReadOnly, [DisplayName]);
  1607.       Validate(Buffer);
  1608.       Check(FDSCursor.PutField(RecBuf, FieldNo, Buffer));
  1609.     end else
  1610.     begin
  1611.       Inc(RecBuf, FRecordSize + Offset);
  1612.       Boolean(RecBuf[0]) := LongBool(Buffer);
  1613.       if Boolean(RecBuf[0]) then Move(Buffer^, RecBuf[1], DataSize);
  1614.     end;
  1615.     if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  1616.       DataEvent(deFieldChange, Longint(Field));
  1617.   end;
  1618. end;
  1619.  
  1620. function TClientDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  1621. begin
  1622.   Result := TDSBlobStream.Create(Field as TBlobField, Mode);
  1623. end;
  1624.  
  1625. function TClientDataSet.BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
  1626. begin
  1627.   Result := FMTBCDToCurr(FMTBCD(BCD^), Curr);
  1628. end;
  1629.  
  1630. function TClientDataSet.CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  1631.   Decimals: Integer): Boolean;
  1632. begin
  1633.   Result := CurrToFMTBCD(Curr, FMTBCD(BCD^), Precision, Decimals);
  1634. end;
  1635.  
  1636. procedure TClientDataSet.RefreshInternalCalcFields(Buffer: PChar);
  1637. begin
  1638.   CalculateFields(Buffer);
  1639. end;
  1640.  
  1641. function TClientDataSet.CalcFieldsCallBack(RecBuf: PChar): DBIResult;
  1642. var
  1643.   SaveState: TDataSetState;
  1644. begin
  1645.   try
  1646.     SaveState := SetTempState(dsCalcFields);
  1647.     try
  1648.       CalculateFields(RecBuf);
  1649.     finally
  1650.       RestoreState(SaveState);
  1651.     end;
  1652.   except
  1653.   end;
  1654.   Result := 0;
  1655. end;
  1656.  
  1657. { Navigation / Editing }
  1658.  
  1659. procedure TClientDataSet.InternalFirst;
  1660. begin
  1661.   Check(FDSCursor.MoveToBOF);
  1662. end;
  1663.  
  1664. procedure TClientDataSet.InternalLast;
  1665. begin
  1666.   CheckProviderEOF;
  1667.   Check(FDSCursor.MoveToEOF);
  1668. end;
  1669.  
  1670. procedure TClientDataSet.InternalPost;
  1671. begin
  1672.   if State = dsEdit then
  1673.     Check(FDSCursor.ModifyRecord(ActiveBuffer)) else
  1674.     Check(FDSCursor.InsertRecord(ActiveBuffer));
  1675. end;
  1676.  
  1677. procedure TClientDataSet.InternalDelete;
  1678. var
  1679.   Result: DBIResult;
  1680. begin
  1681.   Result := FDSCursor.DeleteRecord;
  1682.   if (Result <> DBIERR_NONE) and (Hi(Result) = ERRCAT_NOTFOUND) then
  1683.     Check(Result);
  1684. end;
  1685.  
  1686. procedure TClientDataSet.Post;
  1687. begin
  1688.   inherited Post;
  1689.   if State = dsSetKey then
  1690.     PostKeyBuffer(True);
  1691. end;
  1692.  
  1693. procedure TClientDataSet.Cancel;
  1694. begin
  1695.   inherited Cancel;
  1696.   if State = dsSetKey then
  1697.     PostKeyBuffer(False);
  1698. end;
  1699.  
  1700. procedure TClientDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  1701. begin
  1702.   if Append then FDSCursor.MoveToEOF;
  1703.   Check(FDSCursor.InsertRecord(Buffer));
  1704. end;
  1705.  
  1706. procedure TClientDataSet.InternalGotoBookmark(Bookmark: TBookmark);
  1707. begin
  1708.   Check(FDSCursor.MoveToBookmark(Bookmark));
  1709. end;
  1710.  
  1711. procedure TClientDataSet.InternalSetToRecord(Buffer: PChar);
  1712. begin
  1713.   InternalGotoBookmark(Buffer + FBookmarkOfs);
  1714. end;
  1715.  
  1716. function TClientDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  1717. begin
  1718.   Result := PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag;
  1719. end;
  1720.  
  1721. procedure TClientDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  1722. begin
  1723.   PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag := Value;
  1724. end;
  1725.  
  1726. procedure TClientDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
  1727. begin
  1728.   Move(Buffer[FBookmarkOfs], Data^, BookmarkSize);
  1729. end;
  1730.  
  1731. procedure TClientDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
  1732. begin
  1733.   Move(Data^, ActiveBuffer[FBookmarkOfs], BookmarkSize);
  1734. end;
  1735.  
  1736. function TClientDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  1737. const
  1738.   RetCodes: array[Boolean, Boolean] of ShortInt = ((2, -1),(1, 0));
  1739. begin
  1740.   { Check for uninitialized bookmarks }
  1741.   Result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
  1742.   if Result = 2 then
  1743.   begin
  1744.     Check(FDSCursor.CompareBookmarks(Bookmark1, Bookmark2, Result));
  1745.     if Result = 2 then Result := 0;
  1746.   end;
  1747. end;
  1748.  
  1749. function TClientDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
  1750. begin
  1751.   { ! I think we need to also call GetCurrentRecord here }
  1752.   Result := FDSCursor.MoveToBookmark(Bookmark) = DBIERR_NONE;
  1753.   if Result then CursorPosChanged;
  1754. end;
  1755.  
  1756. procedure TClientDataSet.SyncCursors(Cursor1, Cursor2: IDSCursor);
  1757. var
  1758.   BM: DSBOOKMRK;
  1759. begin
  1760.   Cursor2.GetCurrentBookmark(@BM);
  1761.   Cursor1.MoveToBookmark(@BM);
  1762. end;
  1763.  
  1764. function TClientDataSet.UndoLastChange(FollowChange: Boolean): Boolean;
  1765. begin
  1766.   Cancel;
  1767.   CheckBrowseMode;
  1768.   UpdateCursorPos;
  1769.   Result := (FDSCursor.UndoLastChange(FollowChange) = DBIERR_NONE);
  1770.   if Result then
  1771.   begin
  1772.     if FollowChange then CursorPosChanged;
  1773.     Resync([]);
  1774.   end;
  1775. end;
  1776.  
  1777. procedure TClientDataSet.RevertRecord;
  1778. begin
  1779.   Cancel;
  1780.   CheckBrowseMode;
  1781.   UpdateCursorPos;
  1782.   Check(FDSCursor.RevertRecord);
  1783.   Resync([]);
  1784. end;
  1785.  
  1786. procedure TClientDataSet.CancelUpdates;
  1787. begin
  1788.   Cancel;
  1789.   CheckBrowseMode;
  1790.   UpdateCursorPos;
  1791.   while FDSCursor.UndoLastChange(False) = DBIERR_NONE do {nothing} ;
  1792.   CursorPosChanged;
  1793.   Resync([]);
  1794. end;
  1795.  
  1796. { Indexes }
  1797.  
  1798. procedure TClientDataSet.UpdateIndexDefs;
  1799. type
  1800.   PIndexDescList = ^TIndexDescList;
  1801.   TIndexDescList = array[1..64] of DSIDXDesc;
  1802. var
  1803.   I: Integer;
  1804.   CursorProps: DSProps;
  1805.   IndexDescs: PIndexDescList;
  1806.   Options: TIndexOptions;
  1807.   Name, Fields: string;
  1808. begin
  1809.   if Active and not IndexDefs.Updated then
  1810.   begin
  1811.     FieldDefs.Update;
  1812.     Check(FDSCursor.GetCursorProps(CursorProps));
  1813.     IndexDescs := AllocMem(CursorProps.iIndexes * SizeOf(CursorProps));
  1814.     try
  1815.       IndexDefs.Clear;
  1816.       Check(FDSBase.GetIndexDescs(PDSIDXDesc(IndexDescs)));
  1817.       for I := 1 to CursorProps.iIndexes do
  1818.       begin
  1819.         DecodeIndexDesc(IndexDescs^[I], Name, Fields, Options);
  1820.         with IndexDefs do
  1821.           Add(Name, Fields, Options);
  1822.       end;
  1823.       IndexDefs.Updated := True;
  1824.     finally
  1825.       FreeMem(IndexDescs, CursorProps.iIndexes * SizeOf(CursorProps));
  1826.     end;
  1827.   end;
  1828. end;
  1829.  
  1830. procedure TClientDataSet.DecodeIndexDesc(const IndexDesc: DSIDXDesc;
  1831.   var Name, Fields: string; var Options: TIndexOptions);
  1832. var
  1833.   I: Integer;
  1834. begin
  1835.   with IndexDesc do
  1836.   begin
  1837.     Name := szName;
  1838.     Options := [];
  1839.     if bUnique then Include(Options, ixUnique);
  1840.     Fields := '';
  1841.     for I := 0 to iFields - 1 do
  1842.     begin
  1843.       if I <> 0 then Fields := Fields + ';';
  1844.       Fields := Fields + FieldDefs[iKeyFields[I] - 1].Name;
  1845.     end;
  1846.   end;
  1847. end;
  1848.  
  1849. procedure TClientDataSet.GetIndexNames(List: TStrings);
  1850. var
  1851.   I: Integer;
  1852. begin
  1853.   UpdateIndexDefs;
  1854.   List.BeginUpdate;
  1855.   try
  1856.     List.Clear;
  1857.     for I := 0 to IndexDefs.Count - 1 do
  1858.       with IndexDefs[I] do
  1859.         if Name <> '' then List.Add(Name);
  1860.   finally
  1861.     List.EndUpdate;
  1862.   end;
  1863. end;
  1864.  
  1865. function TClientDataSet.GetIndexDefs: TIndexDefs;
  1866. begin
  1867.   if FIndexDefs = nil then
  1868.     FIndexDefs := TIndexDefs.Create(Self);
  1869.   Result := FIndexDefs;
  1870. end;
  1871.  
  1872. procedure TClientDataSet.GetIndexInfo;
  1873. var
  1874.   IndexDesc: DSIDXDesc;
  1875. begin
  1876.   if FDSCursor.GetIndexDescs(True, IndexDesc) = 0 then
  1877.   begin
  1878.     FIndexFieldCount := IndexDesc.iFields;
  1879.     FIndexFieldMap := IndexDesc.iKeyFields;
  1880.     FKeySize := IndexDesc.iKeyLen;
  1881.   end;
  1882. end;
  1883.  
  1884. procedure TClientDataSet.SwitchToIndex(const IndexName: string);
  1885. begin
  1886.   ResetCursorRange;
  1887.   Check(FDSCursor.UseIndexOrder(PChar(IndexName)));
  1888.   GetIndexInfo;
  1889. end;
  1890.  
  1891. procedure TClientDataSet.SetIndex(const Value: string; FieldsIndex: Boolean);
  1892. begin
  1893.   if Active then
  1894.   begin
  1895.     CheckBrowseMode;
  1896.     UpdateCursorPos;
  1897.     CheckProviderEOF;
  1898.     if (FIndexName <> Value) or (FFieldsIndex <> FieldsIndex) then
  1899.     begin
  1900.       if FieldsIndex then
  1901.         SortOnFields(FDSCursor, Value, False, False) else
  1902.         SwitchToIndex(Value);
  1903.       CheckMasterRange;
  1904.       Resync([]);
  1905.     end;
  1906.   end;
  1907.   FIndexName := Value;
  1908.   FFieldsIndex := FieldsIndex;
  1909. end;
  1910.  
  1911. procedure TClientDataSet.EncodeIndexDesc(var IndexDesc: DSIDXDesc;
  1912.   const Name, Fields: string; Options: TIndexOptions);
  1913. var
  1914.   Pos: Integer;
  1915.   descending,
  1916.   CaseInsensitive: Bool;
  1917. begin
  1918.   FillChar(IndexDesc, SizeOf(IndexDesc), 0);
  1919.   with IndexDesc do
  1920.   begin
  1921.     bUnique := ixUnique in Options;
  1922.     Descending := ixDescending in Options;
  1923.     CaseInsensitive := ixCaseInsensitive in Options;
  1924.     Pos := 1;
  1925.     while (Pos <= Length(Fields)) and (iFields < MAXKEYFIELDS) do
  1926.     begin
  1927.       iKeyFields[iFields] :=
  1928.         FieldDefs.Find(ExtractFieldName(Fields, Pos)).FieldNo;
  1929.       bDescending[iFields] := Descending;
  1930.       bCaseInsensitive[iFields] := CaseInsensitive;
  1931.       Inc(iFields);
  1932.     end;
  1933.     StrCopy(szName, PChar(Name));
  1934.   end;
  1935. end;
  1936.  
  1937. procedure TClientDataSet.AddIndex(const Name, Fields: string; Options: TIndexOptions);
  1938. var
  1939.   IndexDesc: DSIDXDesc;
  1940. begin
  1941.   CheckBrowseMode;
  1942.   FieldDefs.Update;
  1943.   EncodeIndexDesc(IndexDesc, Name, Fields, Options);
  1944.   CursorPosChanged;
  1945.   Check(FDSBase.CreateIndex(IndexDesc));
  1946.   IndexDefs.Updated := False;
  1947. end;
  1948.  
  1949. procedure TClientDataSet.DeleteIndex(const Name: string);
  1950. begin
  1951.   CheckBrowseMode;
  1952.   if AnsiCompareText(Name, IndexName) = 0 then IndexName := '';
  1953.   Check(FDSBase.RemoveIndex(PChar(Name)));
  1954.   IndexDefs.Updated := False;
  1955. end;
  1956.  
  1957. function TClientDataSet.GetIndexField(Index: Integer): TField;
  1958. var
  1959.   FieldNo: Integer;
  1960. begin
  1961.   if (Index < 0) or (Index >= FIndexFieldCount) then
  1962.     DatabaseError(SFieldIndexError);
  1963.   FieldNo := FIndexFieldMap[Index];
  1964.   Result := FieldByNumber(FieldNo);
  1965.   if Result = nil then
  1966.     DatabaseErrorFmt(SIndexFieldMissing, [FieldDefs[FieldNo - 1].Name]);
  1967. end;
  1968.  
  1969. function TClientDataSet.GetIsIndexField(Field: TField): Boolean;
  1970. var
  1971.   I: Integer;
  1972. begin
  1973.   Result := False;
  1974.   with Field do
  1975.     if FieldNo > 0 then
  1976.       for I := 0 to FIndexFieldCount - 1 do
  1977.         if FIndexFieldMap[I] = FieldNo then
  1978.         begin
  1979.           Result := True;
  1980.           Exit;
  1981.         end;
  1982. end;
  1983.  
  1984. function TClientDataSet.GetIndexName: string;
  1985. begin
  1986.   if FFieldsIndex then Result := '' else Result := FIndexName;
  1987. end;
  1988.  
  1989. procedure TClientDataSet.SetIndexName(const Value: string);
  1990. begin
  1991.   SetIndex(Value, False);
  1992. end;
  1993.  
  1994. procedure TClientDataSet.SetIndexField(Index: Integer; Value: TField);
  1995. begin
  1996.   GetIndexField(Index).Assign(Value);
  1997. end;
  1998.  
  1999. function TClientDataSet.GetIndexFieldNames: string;
  2000. begin
  2001.   if FFieldsIndex then Result := FIndexName else Result := '';
  2002. end;
  2003.  
  2004. procedure TClientDataSet.SetIndexFieldNames(const Value: string);
  2005. begin
  2006.   SetIndex(Value, Value <> '');
  2007. end;
  2008.  
  2009. function TClientDataSet.GetIndexFieldCount: Integer;
  2010. begin
  2011.   Result := FIndexFieldCount;
  2012. end;
  2013.  
  2014. procedure TClientDataSet.SortOnFields(Cursor: IDSCursor; const Fields: string;
  2015.   CaseInsensitive, Descending: Boolean);
  2016. var
  2017.   I: Integer;
  2018.   FieldList: TList;
  2019.   DescFlags, CaseFlags: DSKEYBOOL;
  2020.  
  2021.   function GetFlags(Flag: Bool; var FlagArray: DSKEYBOOL): Pointer;
  2022.   var
  2023.     J: Integer;
  2024.   begin
  2025.     if not Flag then Result := nil else
  2026.     begin
  2027.       for J := 0 to FieldList.Count - 1 do
  2028.         FlagArray[J] := True;
  2029.       Result := @FlagArray;
  2030.     end;
  2031.   end;
  2032.  
  2033. begin
  2034.   FieldList := TList.Create;
  2035.   try
  2036.     GetFieldList(FieldList, Fields);
  2037.     for I := 0 to FieldList.Count - 1 do
  2038.       if TField(FieldList[I]).FieldNo > 0 then
  2039.         FieldList[I] := Pointer(TField(FieldList[I]).FieldNo) else
  2040.         DatabaseError(SFieldIndexError); { ! Need Better Error here for calc field }
  2041.     Check(Cursor.SortOnFields(FieldList.Count, PInteger(FieldList.List),
  2042.       GetFlags(Descending, DescFlags), GetFlags(CaseInsensitive, CaseFlags)));
  2043.     GetIndexInfo;
  2044.   finally
  2045.     FieldList.Free;
  2046.   end;
  2047. end;
  2048.  
  2049. { Ranges / Keys }
  2050.  
  2051. procedure TClientDataSet.AllocKeyBuffers;
  2052. var
  2053.   KeyIndex: TKeyIndex;
  2054. begin
  2055.   try
  2056.     for KeyIndex := Low(TKeyIndex) to High(TKeyIndex) do
  2057.       FKeyBuffers[KeyIndex] := InitKeyBuffer(
  2058.         AllocMem(SizeOf(TKeyBuffer) + FRecordSize));
  2059.     if Assigned(FCloneSource) then
  2060.       for KeyIndex := Low(TKeyIndex) to High(TKeyIndex) do
  2061.         Move(FCloneSource.FKeyBuffers[KeyIndex]^, FKeyBuffers[KeyIndex]^,
  2062.           SizeOf(TKeyBuffer) + FRecordSize);
  2063.   except
  2064.     FreeKeyBuffers;
  2065.     raise;
  2066.   end;
  2067. end;
  2068.  
  2069. procedure TClientDataSet.FreeKeyBuffers;
  2070. var
  2071.   KeyIndex: TKeyIndex;
  2072. begin
  2073.   for KeyIndex := Low(TKeyIndex) to High(TKeyIndex) do
  2074.     DisposeMem(FKeyBuffers[KeyIndex], SizeOf(TKeyBuffer) + FRecordSize);
  2075. end;
  2076.  
  2077. function TClientDataSet.InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  2078. begin
  2079.   FillChar(Buffer^, SizeOf(TKeyBuffer) + FRecordSize, 0);
  2080.   Check(FDSCursor.InitRecord(PChar(Buffer) + SizeOf(TKeyBuffer)));
  2081.   Result := Buffer;
  2082. end;
  2083.  
  2084. procedure TClientDataSet.CheckSetKeyMode;
  2085. begin
  2086.   if State <> dsSetKey then DatabaseError(SNotEditing);
  2087. end;
  2088.  
  2089. function TClientDataSet.SetCursorRange: Boolean;
  2090. var
  2091.   RangeStart, RangeEnd: PKeyBuffer;
  2092.   StartKey, EndKey: PChar;
  2093. begin
  2094.   Result := False;
  2095.   if not (
  2096.     BuffersEqual(FKeyBuffers[kiRangeStart], FKeyBuffers[kiCurRangeStart],
  2097.     SizeOf(TKeyBuffer) + FRecordSize) and
  2098.     BuffersEqual(FKeyBuffers[kiRangeEnd], FKeyBuffers[kiCurRangeEnd],
  2099.     SizeOf(TKeyBuffer) + FRecordSize)) then
  2100.   begin
  2101.     CheckProviderEOF;
  2102.     RangeStart := FKeyBuffers[kiRangeStart];
  2103.     RangeEnd := FKeyBuffers[kiRangeEnd];
  2104.     StartKey := PChar(RangeStart) + SizeOf(TKeyBuffer);
  2105.     EndKey := PChar(RangeEnd) + SizeOf(TKeyBuffer);
  2106.     Check(FDSCursor.SetRange(RangeStart.FieldCount, StartKey,
  2107.       not RangeStart.Exclusive, EndKey, not RangeEnd.Exclusive));
  2108.     Move(FKeyBuffers[kiRangeStart]^, FKeyBuffers[kiCurRangeStart]^,
  2109.       SizeOf(TKeyBuffer) + FRecordSize);
  2110.     Move(FKeyBuffers[kiRangeEnd]^, FKeyBuffers[kiCurRangeEnd]^,
  2111.       SizeOf(TKeyBuffer) + FRecordSize);
  2112.     DestroyLookupCursor;
  2113.     Result := True;
  2114.   end;
  2115. end;
  2116.  
  2117. function TClientDataSet.ResetCursorRange: Boolean;
  2118. begin
  2119.   Result := False;
  2120.   if FKeyBuffers[kiCurRangeStart].Modified or
  2121.     FKeyBuffers[kiCurRangeEnd].Modified then
  2122.   begin
  2123.     Check(FDSCursor.DropRange);
  2124.     InitKeyBuffer(FKeyBuffers[kiCurRangeStart]);
  2125.     InitKeyBuffer(FKeyBuffers[kiCurRangeEnd]);
  2126.     DestroyLookupCursor;
  2127.     Result := True;
  2128.   end;
  2129. end;
  2130.  
  2131. procedure TClientDataSet.SetLinkRanges(MasterFields: TList);
  2132. var
  2133.   I: Integer;
  2134.   SaveState: TDataSetState;
  2135. begin
  2136.   SaveState := SetTempState(dsSetKey);
  2137.   try
  2138.     FKeyBuffer := InitKeyBuffer(FKeyBuffers[kiRangeStart]);
  2139.     FKeyBuffer^.Modified := True;
  2140.     for I := 0 to MasterFields.Count - 1 do
  2141.       GetIndexField(I).Assign(TField(MasterFields[I]));
  2142.     FKeyBuffer^.FieldCount := MasterFields.Count;
  2143.   finally
  2144.     RestoreState(SaveState);
  2145.   end;
  2146.   Move(FKeyBuffers[kiRangeStart]^, FKeyBuffers[kiRangeEnd]^,
  2147.     SizeOf(TKeyBuffer) + FRecordSize);
  2148. end;
  2149.  
  2150. function TClientDataSet.GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  2151. begin
  2152.   Result := FKeyBuffers[KeyIndex];
  2153. end;
  2154.  
  2155. procedure TClientDataSet.SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  2156. begin
  2157.   CheckBrowseMode;
  2158.   FKeyBuffer := FKeyBuffers[KeyIndex];
  2159.   Move(FKeyBuffer^, FKeyBuffers[kiSave]^, SizeOf(TKeyBuffer) + FRecordSize);
  2160.   if Clear then InitKeyBuffer(FKeyBuffer);
  2161.   SetState(dsSetKey);
  2162.   SetModified(FKeyBuffer.Modified);
  2163.   DataEvent(deDataSetChange, 0);
  2164. end;
  2165.  
  2166. procedure TClientDataSet.PostKeyBuffer(Commit: Boolean);
  2167. begin
  2168.   DataEvent(deCheckBrowseMode, 0);
  2169.   if Commit then
  2170.     FKeyBuffer.Modified := Modified else
  2171.     Move(FKeyBuffers[kiSave]^, FKeyBuffer^, SizeOf(TKeyBuffer) + FRecordSize);
  2172.   SetState(dsBrowse);
  2173.   DataEvent(deDataSetChange, 0);
  2174. end;
  2175.  
  2176. function TClientDataSet.GetKeyExclusive: Boolean;
  2177. begin
  2178.   CheckSetKeyMode;
  2179.   Result := FKeyBuffer.Exclusive;
  2180. end;
  2181.  
  2182. procedure TClientDataSet.SetKeyExclusive(Value: Boolean);
  2183. begin
  2184.   CheckSetKeyMode;
  2185.   FKeyBuffer.Exclusive := Value;
  2186. end;
  2187.  
  2188. function TClientDataSet.GetKeyFieldCount: Integer;
  2189. begin
  2190.   CheckSetKeyMode;
  2191.   Result := FKeyBuffer.FieldCount;
  2192. end;
  2193.  
  2194. procedure TClientDataSet.SetKeyFieldCount(Value: Integer);
  2195. begin
  2196.   CheckSetKeyMode;
  2197.   FKeyBuffer.FieldCount := Value;
  2198. end;
  2199.  
  2200. procedure TClientDataSet.SetKeyFields(KeyIndex: TKeyIndex;
  2201.   const Values: array of const);
  2202. var
  2203.   I: Integer;
  2204.   SaveState: TDataSetState;
  2205. begin
  2206.   if FIndexFieldCount = 0 then DatabaseError(SNoFieldIndexes);
  2207.   SaveState := SetTempState(dsSetKey);
  2208.   try
  2209.     FKeyBuffer := InitKeyBuffer(FKeyBuffers[KeyIndex]);
  2210.     for I := 0 to High(Values) do GetIndexField(I).AssignValue(Values[I]);
  2211.     FKeyBuffer^.FieldCount := High(Values) + 1;
  2212.     FKeyBuffer^.Modified := Modified;
  2213.   finally
  2214.     RestoreState(SaveState);
  2215.   end;
  2216. end;
  2217.  
  2218. function TClientDataSet.FindKey(const KeyValues: array of const): Boolean;
  2219. begin
  2220.   CheckBrowseMode;
  2221.   SetKeyFields(kiLookup, KeyValues);
  2222.   Result := GotoKey;
  2223. end;
  2224.  
  2225. procedure TClientDataSet.FindNearest(const KeyValues: array of const);
  2226. begin
  2227.   CheckBrowseMode;
  2228.   SetKeyFields(kiLookup, KeyValues);
  2229.   GotoNearest
  2230. end;
  2231.  
  2232. function TClientDataSet.GotoKey: Boolean;
  2233. var
  2234.   KeyBuffer: PKeyBuffer;
  2235.   RecBuffer: PChar;
  2236. begin
  2237.   CheckBrowseMode;
  2238.   CursorPosChanged;
  2239.   CheckProviderEOF;
  2240.   KeyBuffer := GetKeyBuffer(kiLookup);
  2241.   RecBuffer := PChar(KeyBuffer) + SizeOf(TKeyBuffer);
  2242.   Result := FDSCursor.GetRecordForKey(KeyBuffer.FieldCount, 0, RecBuffer, nil) = 0;
  2243.   if Result then Resync([rmExact, rmCenter]);
  2244. end;
  2245.  
  2246. procedure TClientDataSet.GotoNearest;
  2247. var
  2248.   SearchCond: DBISearchCond;
  2249.   KeyBuffer: PKeyBuffer;
  2250.   RecBuffer: PChar;
  2251. begin
  2252.   CheckBrowseMode;
  2253.   CheckProviderEOF;
  2254.   KeyBuffer := GetKeyBuffer(kiLookup);
  2255.   RecBuffer := PChar(KeyBuffer) + SizeOf(TKeyBuffer);
  2256.   if KeyBuffer^.Exclusive then
  2257.     SearchCond := keySEARCHGT else
  2258.     SearchCond := keySEARCHGEQ;
  2259.   Check(FDSCursor.MoveToKey(SearchCond, KeyBuffer.FieldCount, 0, RecBuffer));
  2260.   Resync([rmCenter]);
  2261. end;
  2262.  
  2263. procedure TClientDataSet.SetKey;
  2264. begin
  2265.   SetKeyBuffer(kiLookup, True);
  2266. end;
  2267.  
  2268. procedure TClientDataSet.EditKey;
  2269. begin
  2270.   SetKeyBuffer(kiLookup, False);
  2271. end;
  2272.  
  2273. procedure TClientDataSet.ApplyRange;
  2274. begin
  2275.   CheckBrowseMode;
  2276.   if SetCursorRange then First;
  2277. end;
  2278.  
  2279. procedure TClientDataSet.CancelRange;
  2280. begin
  2281.   CheckBrowseMode;
  2282.   UpdateCursorPos;
  2283.   if ResetCursorRange then Resync([]);
  2284. end;
  2285.  
  2286. procedure TClientDataSet.SetRange(const StartValues, EndValues: array of const);
  2287. begin
  2288.   CheckBrowseMode;
  2289.   SetKeyFields(kiRangeStart, StartValues);
  2290.   SetKeyFields(kiRangeEnd, EndValues);
  2291.   ApplyRange;
  2292. end;
  2293.  
  2294. procedure TClientDataSet.SetRangeEnd;
  2295. begin
  2296.   SetKeyBuffer(kiRangeEnd, True);
  2297. end;
  2298.  
  2299. procedure TClientDataSet.SetRangeStart;
  2300. begin
  2301.   SetKeyBuffer(kiRangeStart, True);
  2302. end;
  2303.  
  2304. procedure TClientDataSet.EditRangeEnd;
  2305. begin
  2306.   SetKeyBuffer(kiRangeEnd, False);
  2307. end;
  2308.  
  2309. procedure TClientDataSet.EditRangeStart;
  2310. begin
  2311.   SetKeyBuffer(kiRangeStart, False);
  2312. end;
  2313.  
  2314. { Master / Detail }
  2315.  
  2316. procedure TClientDataSet.CheckMasterRange;
  2317. begin
  2318.   if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
  2319.   begin
  2320.     SetLinkRanges(FMasterLink.Fields);
  2321.     SetCursorRange;
  2322.   end;
  2323. end;
  2324.  
  2325. procedure TClientDataSet.MasterChanged(Sender: TObject);
  2326. begin
  2327.   CheckBrowseMode;
  2328.   SetLinkRanges(FMasterLink.Fields);
  2329.   ApplyRange;
  2330. end;
  2331.  
  2332. procedure TClientDataSet.MasterDisabled(Sender: TObject);
  2333. begin
  2334.   CancelRange;
  2335. end;
  2336.  
  2337. procedure TClientDataSet.Loaded;
  2338. begin
  2339.   inherited Loaded;
  2340.   if not VarIsNull(FData) then Open;
  2341. end;
  2342.  
  2343. procedure TClientDataSet.ReadData(Stream: TStream);
  2344. var
  2345.   Size: Integer;
  2346.   FDataPtr: Pointer;
  2347. begin
  2348.   Stream.ReadBuffer(Size, SizeOf(Size));
  2349.   if Size > 0 then
  2350.   begin
  2351.     FData := VarArrayCreate([0, Size-1], varByte);
  2352.     try
  2353.       FDataPtr := VarArrayLock(FData);
  2354.       try
  2355.         Stream.ReadBuffer(FDataPtr^, Size);
  2356.       finally
  2357.         VarArrayUnlock(FData);
  2358.       end;
  2359.     except
  2360.       FData := System.NULL;
  2361.       raise;
  2362.     end;
  2363.   end else
  2364.     FData := System.NULL;
  2365. end;
  2366.  
  2367. procedure TClientDataSet.WriteData(Stream: TStream);
  2368. var
  2369.   P: Pointer;
  2370.   Size: Integer;
  2371. begin
  2372.   CheckBrowseMode;
  2373.   P := VarArrayLock(FData);
  2374.   try
  2375.     Size := VarArrayHighBound(FData, 1);
  2376.     Stream.WriteBuffer(Size, SizeOf(Size));
  2377.     Stream.WriteBuffer(P^, Size);
  2378.   finally
  2379.     VarArrayUnlock(FData);
  2380.   end;
  2381. end;
  2382.  
  2383. function TClientDataSet.GetDataSource: TDataSource;
  2384. begin
  2385.   Result := FMasterLink.DataSource;
  2386. end;
  2387.  
  2388. procedure TClientDataSet.SetDataSource(Value: TDataSource);
  2389. begin
  2390.   if IsLinkedTo(Value) then DatabaseError(SCircularDataLink);
  2391.   FMasterLink.DataSource := Value;
  2392. end;
  2393.  
  2394. function TClientDataSet.GetMasterFields: string;
  2395. begin
  2396.   Result := FMasterLink.FieldNames;
  2397. end;
  2398.  
  2399. procedure TClientDataSet.SetMasterFields(const Value: string);
  2400. begin
  2401.   FMasterLink.FieldNames := Value;
  2402. end;
  2403.  
  2404. procedure TClientDataSet.DoOnNewRecord;
  2405. var
  2406.   I: Integer;
  2407. begin
  2408.   if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
  2409.     for I := 0 to FMasterLink.Fields.Count - 1 do
  2410.       IndexFields[I] := TField(FMasterLink.Fields[I]);
  2411.   inherited DoOnNewRecord;
  2412. end;
  2413.  
  2414. procedure TClientDataSet.DefineProperties(Filer: TFiler);
  2415. begin
  2416.   inherited DefineProperties(Filer);
  2417.   Filer.DefineBinaryProperty('Data', ReadData, WriteData, ((State = dsBrowse) and
  2418.     not VarIsNull(FData) and not Assigned(FProvider)));
  2419. end;
  2420.  
  2421. { Filters }
  2422.  
  2423. procedure TClientDataSet.ActivateFilters;
  2424. begin
  2425.   if Filter <> '' then
  2426.     AddExprFilter(Filter, FilterOptions);
  2427.   if Assigned(OnFilterRecord) then
  2428.     AddFuncFilter;
  2429. end;
  2430.  
  2431. procedure TClientDataSet.DeactivateFilters;
  2432. begin
  2433.   if FFuncFilter <> nil then
  2434.   begin
  2435.     FDSCursor.DropFilter(FFuncFilter);
  2436.     FFuncFilter := nil;
  2437.   end;
  2438.   if FExprFilter <> nil then
  2439.   begin
  2440.     FDSCursor.DropFilter(FExprFilter);
  2441.     FExprFilter := nil;
  2442.   end;
  2443. end;
  2444.  
  2445. procedure TClientDataSet.AddExprFilter(const Expr: string; Options: TFilterOptions);
  2446. begin
  2447.   if FExprFilter <> nil then FDSCursor.DropFilter(FExprFilter);
  2448.   if Expr <> '' then
  2449.     with TExprParser.Create(Self, Expr, Options) do
  2450.     try
  2451.       CheckProviderEOF;
  2452.       Check(FDSCursor.AddFilter(FilterData, DataSize, FExprFilter));
  2453.     finally
  2454.       Free;
  2455.     end;
  2456. end;
  2457.  
  2458. function TClientDataSet.FilterCallback(RecBuf: PChar): Bool;
  2459. var
  2460.   SaveState: TDataSetState;
  2461.   Accept: Boolean;
  2462. begin
  2463.   SaveState := SetTempState(dsFilter);
  2464.   FFilterBuffer := RecBuf;
  2465.   try
  2466.     Accept := True;
  2467.     OnFilterRecord(Self, Accept);
  2468.   except
  2469.     Application.HandleException(Self);
  2470.   end;
  2471.   RestoreState(SaveState);
  2472.   Result := Accept;
  2473. end;
  2474.  
  2475. procedure TClientDataSet.AddFuncFilter;
  2476. begin
  2477.   if FFuncFilter <> nil then FDSCursor.DropFilter(FFuncFilter);
  2478.   CheckProviderEOF;
  2479.   Check(FDSCursor.AddFilterCallBack(Integer(Self), @TClientDataSet.FilterCallback,
  2480.     FFuncFilter));
  2481. end;
  2482.  
  2483. procedure TClientDataSet.SetFilterData(const Text: string; Options: TFilterOptions);
  2484. begin
  2485.   if Active and Filtered then
  2486.   begin
  2487.     CheckBrowseMode;
  2488.     if (Filter <> Text) or (FilterOptions <> Options) then
  2489.       AddExprFilter(Text, Options);
  2490.     DestroyLookupCursor;
  2491.     First;
  2492.   end;
  2493.   inherited SetFilterText(Text);
  2494.   inherited SetFilterOptions(Options);
  2495. end;
  2496.  
  2497. procedure TClientDataSet.SetFilterText(const Value: string);
  2498. begin
  2499.   SetFilterData(Value, FilterOptions);
  2500. end;
  2501.  
  2502. procedure TClientDataSet.SetFilterOptions(Value: TFilterOptions);
  2503. begin
  2504.   SetFilterData(Filter, Value);
  2505. end;
  2506.  
  2507. procedure TClientDataSet.SetOnFilterRecord(const Value: TFilterRecordEvent);
  2508. begin
  2509.   if Active and Filtered then
  2510.   begin
  2511.     CheckBrowseMode;
  2512.     if Assigned(OnFilterRecord) <> Assigned(Value) then
  2513.     begin
  2514.       if Assigned(Value) then
  2515.       begin
  2516.         inherited SetOnFilterRecord(Value);
  2517.         AddFuncFilter;
  2518.       end else
  2519.         FDSCursor.DropFilter(FFuncFilter);
  2520.     end;
  2521.     DestroyLookupCursor;
  2522.     First;
  2523.   end;
  2524.   inherited SetOnFilterRecord(Value);
  2525. end;
  2526.  
  2527. procedure TClientDataSet.SetFiltered(Value: Boolean);
  2528. begin
  2529.   if Active then
  2530.   begin
  2531.     CheckBrowseMode;
  2532.     if Filtered <> Value then
  2533.     begin
  2534.       DestroyLookupCursor;
  2535.       FDSCursor.MoveToBOF;
  2536.       if Value then ActivateFilters else DeactivateFilters;
  2537.       inherited SetFiltered(Value);
  2538.     end;
  2539.     First;
  2540.   end else
  2541.     inherited SetFiltered(Value);
  2542. end;
  2543.  
  2544. function TClientDataSet.FindRecord(Restart, GoForward: Boolean): Boolean;
  2545. var
  2546.   Status: DBIResult;
  2547.   Cursor: IDSCursor;
  2548. begin
  2549.   CheckBrowseMode;
  2550.   SetFound(False);
  2551.   UpdateCursorPos;
  2552.   CursorPosChanged;
  2553.   CheckProviderEOF;
  2554.   DoBeforeScroll;
  2555.   if not Filtered then
  2556.   begin
  2557.     if not Assigned(FFindCursor) then
  2558.     begin
  2559.       ActivateFilters;
  2560.       try
  2561.         FFindCursor := CreateDSCursor(FDSCursor)
  2562.       finally
  2563.         DeactivateFilters;
  2564.       end;
  2565.     end else
  2566.       if not Restart then SyncCursors(FFindCursor, FDSCursor);
  2567.     Cursor := FFindCursor;
  2568.   end else
  2569.     Cursor := FDSCursor;
  2570.   if GoForward then
  2571.   begin
  2572.     if Restart then Check(Cursor.MoveToBOF);
  2573.     Status := Cursor.MoveRelative(1);
  2574.   end else
  2575.   begin
  2576.     if Restart then Check(Cursor.MoveToEOF);
  2577.     Status := Cursor.MoveRelative(-1);
  2578.   end;
  2579.   if Cursor <> FDSCursor then
  2580.     SyncCursors(FDSCursor, FFindCursor);
  2581.   if Status = DBIERR_NONE then
  2582.   begin
  2583.     Resync([rmExact, rmCenter]);
  2584.     SetFound(True);
  2585.   end;
  2586.   Result := Found;
  2587.   if Result then DoAfterScroll;
  2588. end;
  2589.  
  2590. procedure TClientDataSet.DestroyLookupCursor;
  2591. begin
  2592.   FLookupCursor := nil;
  2593.   FFindCursor := nil;
  2594. end;
  2595.  
  2596. function TClientDataSet.LocateRecord(const KeyFields: string;
  2597.   const KeyValues: Variant; Options: TLocateOptions;
  2598.   SyncCursor: Boolean): Boolean;
  2599. var
  2600.   Fields: TList;
  2601.   Buffer: PChar;
  2602.   I, FieldCount, PartialLength: Integer;
  2603.   Status: DBIResult;
  2604.   CaseInsensitive: Boolean;
  2605. begin
  2606.   CheckBrowseMode;
  2607.   CursorPosChanged;
  2608.   CheckProviderEOF;
  2609.   Buffer := TempBuffer;
  2610.   Fields := TList.Create;
  2611.   try
  2612.     GetFieldList(Fields, KeyFields);
  2613.     CaseInsensitive := loCaseInsensitive in Options;
  2614.     if not Assigned(FLookupCursor) then
  2615.       FLookupCursor := CreateDSCursor(FDSCursor);
  2616.     SortOnFields(FLookupCursor, KeyFields, CaseInsensitive, False);
  2617.     FFilterBuffer := Buffer;
  2618.     SetTempState(dsFilter);
  2619.     try
  2620.       InitRecord(Buffer);
  2621.       FieldCount := Fields.Count;
  2622.       if FieldCount = 1 then
  2623.         TField(Fields.First).Value := KeyValues
  2624.       else
  2625.         for I := 0 to FieldCount - 1 do
  2626.           TField(Fields[I]).Value := KeyValues[I];
  2627.       PartialLength := 0;
  2628.       if (loPartialKey in Options) and
  2629.         (TField(Fields.Last).DataType = ftString) then
  2630.       begin
  2631.         Dec(FieldCount);
  2632.         PartialLength := Length(TField(Fields.Last).AsString);
  2633.       end;
  2634.       Status := FLookupCursor.GetRecordForKey(FieldCount, PartialLength, Buffer, Buffer);
  2635.     finally
  2636.       RestoreState(dsBrowse);
  2637.     end;
  2638.     if SyncCursor and (Status = DBIERR_NONE) then
  2639.       SyncCursors(FDSCursor, FLookupCursor);
  2640.   finally
  2641.     Fields.Free;
  2642.   end;
  2643.   Result := Status = DBIERR_NONE;
  2644. end;
  2645.  
  2646. function TClientDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
  2647.   const ResultFields: string): Variant;
  2648. begin
  2649.   Result := Null;
  2650.   if LocateRecord(KeyFields, KeyValues, [], False) then
  2651.   begin
  2652.     SetTempState(dsCalcFields);
  2653.     try
  2654.       CalculateFields(TempBuffer);
  2655.       Result := FieldValues[ResultFields];
  2656.     finally
  2657.       RestoreState(dsBrowse);
  2658.     end;
  2659.   end;
  2660. end;
  2661.  
  2662. function TClientDataSet.Locate(const KeyFields: string;
  2663.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  2664. begin
  2665.   DoBeforeScroll;
  2666.   Result := LocateRecord(KeyFields, KeyValues, Options, True);
  2667.   if Result then
  2668.   begin
  2669.     Resync([rmExact, rmCenter]);
  2670.     DoAfterScroll;
  2671.   end;
  2672. end;
  2673.  
  2674. procedure TClientDataSet.GotoCurrent(DataSet: TClientDataSet);
  2675. begin
  2676.   CheckBrowseMode;
  2677.   CheckProviderEOF;
  2678.   DataSet.CheckActive;
  2679.   BookMark := DataSet.BookMark;
  2680. end;
  2681.  
  2682. end.
  2683.